Artifact 1ba5251696f0f3b41d10886aa530c2de465642a8:
- File run-tests-queue-new.scm — part of check-in [dec6d535be] at 2013-05-06 14:28:02 on branch v1.54 — Fixed running dependent tests problem (user: mrwellan size: 18070)
0000: 0a 3b 3b 20 74 65 73 74 2d 72 65 63 6f 72 64 73 .;; test-records 0010: 20 69 73 20 61 20 68 61 73 68 20 74 61 62 6c 65 is a hash table 0020: 20 74 65 73 74 6e 61 6d 65 3a 69 74 65 6d 5f 70 testname:item_p 0030: 61 74 68 20 3d 3e 20 76 65 63 74 6f 72 20 3c 20 ath => vector < 0040: 74 65 73 74 6e 61 6d 65 20 74 65 73 74 63 6f 6e testname testcon 0050: 66 69 67 20 77 61 69 74 6f 6e 73 20 70 72 69 6f fig waitons prio 0060: 72 69 74 79 20 69 74 65 6d 73 2d 69 6e 66 6f 20 rity items-info 0070: 2e 2e 2e 20 3e 0a 28 64 65 66 69 6e 65 20 28 72 ... >.(define (r 0080: 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 2d 71 75 uns:run-tests-qu 0090: 65 75 65 2d 6e 65 77 20 72 75 6e 2d 69 64 20 72 eue-new run-id r 00a0: 75 6e 6e 61 6d 65 20 74 65 73 74 2d 72 65 63 6f unname test-reco 00b0: 72 64 73 20 6b 65 79 76 61 6c 6c 73 74 20 66 6c rds keyvallst fl 00c0: 61 67 73 20 74 65 73 74 2d 70 61 74 74 73 20 72 ags test-patts r 00d0: 65 71 75 69 72 65 64 2d 74 65 73 74 73 20 72 65 equired-tests re 00e0: 67 6c 65 6e 29 0a 20 20 3b 3b 20 41 74 20 74 68 glen). ;; At th 00f0: 69 73 20 70 6f 69 6e 74 20 74 68 65 20 6c 69 73 is point the lis 0100: 74 20 6f 66 20 70 61 72 65 6e 74 20 74 65 73 74 t of parent test 0110: 73 20 69 73 20 65 78 70 61 6e 64 65 64 20 0a 20 s is expanded . 0120: 20 3b 3b 20 4e 42 2f 2f 20 53 68 6f 75 6c 64 20 ;; NB// Should 0130: 65 78 70 61 6e 64 20 69 74 65 6d 73 20 68 65 72 expand items her 0140: 65 20 61 6e 64 20 74 68 65 6e 20 69 6e 73 65 72 e and then inser 0150: 74 20 69 6e 74 6f 20 74 68 65 20 72 75 6e 20 71 t into the run q 0160: 75 65 75 65 2e 0a 20 20 28 64 65 62 75 67 3a 70 ueue.. (debug:p 0170: 72 69 6e 74 20 35 20 22 74 65 73 74 2d 72 65 63 rint 5 "test-rec 0180: 6f 72 64 73 3a 20 22 20 74 65 73 74 2d 72 65 63 ords: " test-rec 0190: 6f 72 64 73 20 22 2c 20 6b 65 79 76 61 6c 6c 73 ords ", keyvalls 01a0: 74 3a 20 22 20 6b 65 79 76 61 6c 6c 73 74 20 22 t: " keyvallst " 01b0: 20 66 6c 61 67 73 3a 20 22 20 28 68 61 73 68 2d flags: " (hash- 01c0: 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 66 6c 61 table->alist fla 01d0: 67 73 29 29 0a 20 20 28 6c 65 74 20 28 28 72 75 gs)). (let ((ru 01e0: 6e 2d 69 6e 66 6f 20 20 20 20 20 20 20 20 20 20 n-info 01f0: 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d (cdb:remote- 0200: 72 75 6e 20 64 62 3a 67 65 74 2d 72 75 6e 2d 69 run db:get-run-i 0210: 6e 66 6f 20 23 66 20 72 75 6e 2d 69 64 29 29 0a nfo #f run-id)). 0220: 09 28 6b 65 79 2d 76 61 6c 73 20 20 20 20 20 20 .(key-vals 0230: 20 20 20 20 20 20 20 20 28 63 64 62 3a 72 65 6d (cdb:rem 0240: 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b ote-run db:get-k 0250: 65 79 2d 76 61 6c 73 20 23 66 20 72 75 6e 2d 69 ey-vals #f run-i 0260: 64 29 29 0a 09 28 73 6f 72 74 65 64 2d 74 65 73 d))..(sorted-tes 0270: 74 2d 6e 61 6d 65 73 20 20 20 20 20 28 74 65 73 t-names (tes 0280: 74 73 3a 73 6f 72 74 2d 62 79 2d 70 72 69 6f 72 ts:sort-by-prior 0290: 69 74 79 2d 61 6e 64 2d 77 61 69 74 6f 6e 20 74 ity-and-waiton t 02a0: 65 73 74 2d 72 65 63 6f 72 64 73 29 29 0a 09 28 est-records))..( 02b0: 74 65 73 74 2d 72 65 67 69 73 74 72 79 20 20 20 test-registry 02c0: 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 (make-hash 02d0: 2d 74 61 62 6c 65 29 29 0a 09 28 72 65 67 69 73 -table))..(regis 02e0: 74 72 79 2d 6d 75 74 65 78 20 20 20 20 20 20 20 try-mutex 02f0: 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 09 (make-mutex)).. 0300: 28 6e 75 6d 2d 72 65 74 72 69 65 73 20 20 20 20 (num-retries 0310: 20 20 20 20 20 20 20 30 29 0a 09 28 6d 61 78 2d 0)..(max- 0320: 72 65 74 72 69 65 73 20 20 20 20 20 20 20 20 20 retries 0330: 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 (config-lookup 0340: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se 0350: 74 75 70 22 20 22 6d 61 78 72 65 74 72 69 65 73 tup" "maxretries 0360: 22 29 29 0a 09 28 6d 61 78 2d 63 6f 6e 63 75 72 "))..(max-concur 0370: 72 65 6e 74 2d 6a 6f 62 73 20 20 20 28 6c 65 74 rent-jobs (let 0380: 20 28 28 6d 63 6a 20 28 63 6f 6e 66 69 67 2d 6c ((mcj (config-l 0390: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat 03a0: 2a 20 22 73 65 74 75 70 22 20 20 20 20 20 22 6d * "setup" "m 03b0: 61 78 5f 63 6f 6e 63 75 72 72 65 6e 74 5f 6a 6f ax_concurrent_jo 03c0: 62 73 22 29 29 29 0a 09 09 09 09 20 28 69 66 20 bs")))..... (if 03d0: 28 61 6e 64 20 6d 63 6a 20 28 73 74 72 69 6e 67 (and mcj (string 03e0: 2d 3e 6e 75 6d 62 65 72 20 6d 63 6a 29 29 0a 09 ->number mcj)).. 03f0: 09 09 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d ... (string- 0400: 3e 6e 75 6d 62 65 72 20 6d 63 6a 29 0a 09 09 09 >number mcj).... 0410: 09 20 20 20 20 20 31 29 29 29 29 20 3b 3b 20 6c . 1)))) ;; l 0420: 65 6e 67 74 68 20 6f 66 20 74 68 65 20 72 65 67 ength of the reg 0430: 69 73 74 65 72 20 71 75 65 75 65 20 61 68 65 61 ister queue ahea 0440: 64 0a 20 20 20 20 28 73 65 74 21 20 6d 61 78 2d d. (set! max- 0450: 72 65 74 72 69 65 73 20 28 69 66 20 28 61 6e 64 retries (if (and 0460: 20 6d 61 78 2d 72 65 74 72 69 65 73 20 28 73 74 max-retries (st 0470: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6d 61 78 ring->number max 0480: 2d 72 65 74 72 69 65 73 29 29 28 73 74 72 69 6e -retries))(strin 0490: 67 2d 3e 6e 75 6d 62 65 72 20 6d 61 78 2d 72 65 g->number max-re 04a0: 74 72 69 65 73 29 20 31 30 30 29 29 0a 20 20 20 tries) 100)). 04b0: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null? 04c0: 20 73 6f 72 74 65 64 2d 74 65 73 74 2d 6e 61 6d sorted-test-nam 04d0: 65 73 29 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 es))..(let loop 04e0: 28 28 68 65 64 20 20 20 20 20 20 20 20 20 28 63 ((hed (c 04f0: 61 72 20 73 6f 72 74 65 64 2d 74 65 73 74 2d 6e ar sorted-test-n 0500: 61 6d 65 73 29 29 0a 09 09 20 20 20 28 74 61 6c ames))... (tal 0510: 20 20 20 20 20 20 20 20 20 28 63 64 72 20 73 6f (cdr so 0520: 72 74 65 64 2d 74 65 73 74 2d 6e 61 6d 65 73 29 rted-test-names) 0530: 29 0a 09 09 20 20 20 28 72 65 67 20 20 20 20 20 )... (reg 0540: 20 20 20 20 27 28 29 29 20 3b 3b 20 72 65 67 69 '()) ;; regi 0550: 73 74 65 72 65 64 2c 20 70 75 74 20 74 68 65 73 stered, put thes 0560: 65 20 61 74 20 74 68 65 20 68 65 61 64 20 6f 66 e at the head of 0570: 20 74 61 6c 20 0a 09 09 20 20 20 28 72 65 72 75 tal ... (reru 0580: 6e 73 20 20 20 20 20 20 27 28 29 29 29 0a 09 20 ns '())).. 0590: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null? 05a0: 20 72 65 72 75 6e 73 29 29 28 64 65 62 75 67 3a reruns))(debug: 05b0: 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 72 65 print-info 4 "re 05c0: 72 75 6e 73 3d 22 20 72 65 72 75 6e 73 29 29 0a runs=" reruns)). 05d0: 09 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 6f . ;; (print "To 05e0: 70 20 6f 66 20 6c 6f 6f 70 2c 20 68 65 64 3d 22 p of loop, hed=" 05f0: 20 68 65 64 20 22 2c 20 74 61 6c 3d 22 20 74 61 hed ", tal=" ta 0600: 6c 20 22 20 2c 72 65 72 75 6e 73 3d 22 20 72 65 l " ,reruns=" re 0610: 72 75 6e 73 29 0a 09 20 20 28 6c 65 74 2a 20 28 runs).. (let* ( 0620: 28 74 65 73 74 2d 72 65 63 6f 72 64 20 28 68 61 (test-record (ha 0630: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes 0640: 74 2d 72 65 63 6f 72 64 73 20 68 65 64 29 29 0a t-records hed)). 0650: 09 09 20 28 74 65 73 74 2d 6e 61 6d 65 20 20 20 .. (test-name 0660: 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 (tests:testqueue 0670: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 -get-testname te 0680: 73 74 2d 72 65 63 6f 72 64 29 29 0a 09 09 20 28 st-record))... ( 0690: 74 63 6f 6e 66 69 67 20 20 20 20 20 28 74 65 73 tconfig (tes 06a0: 74 73 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 ts:testqueue-get 06b0: 2d 74 65 73 74 63 6f 6e 66 69 67 20 74 65 73 74 -testconfig test 06c0: 2d 72 65 63 6f 72 64 29 29 0a 09 09 20 28 74 65 -record))... (te 06d0: 73 74 6d 6f 64 65 20 20 20 20 28 6c 65 74 20 28 stmode (let ( 06e0: 28 6d 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (m (config-looku 06f0: 70 20 74 63 6f 6e 66 69 67 20 22 72 65 71 75 69 p tconfig "requi 0700: 72 65 6d 65 6e 74 73 22 20 22 6d 6f 64 65 22 29 rements" "mode") 0710: 29 29 0a 09 09 09 09 28 69 66 20 6d 20 28 73 74 )).....(if m (st 0720: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6d 29 20 ring->symbol m) 0730: 27 6e 6f 72 6d 61 6c 29 29 29 0a 09 09 20 28 77 'normal)))... (w 0740: 61 69 74 6f 6e 73 20 20 20 20 20 28 74 65 73 74 aitons (test 0750: 73 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d s:testqueue-get- 0760: 77 61 69 74 6f 6e 73 20 20 20 20 74 65 73 74 2d waitons test- 0770: 72 65 63 6f 72 64 29 29 0a 09 09 20 28 70 72 69 record))... (pri 0780: 6f 72 69 74 79 20 20 20 20 28 74 65 73 74 73 3a ority (tests: 0790: 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 70 72 testqueue-get-pr 07a0: 69 6f 72 69 74 79 20 20 20 74 65 73 74 2d 72 65 iority test-re 07b0: 63 6f 72 64 29 29 0a 09 09 20 28 69 74 65 6d 64 cord))... (itemd 07c0: 61 74 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 at (tests:te 07d0: 73 74 71 75 65 75 65 2d 67 65 74 2d 69 74 65 6d stqueue-get-item 07e0: 64 61 74 20 20 20 20 74 65 73 74 2d 72 65 63 6f dat test-reco 07f0: 72 64 29 29 20 3b 3b 20 69 74 65 6d 64 61 74 20 rd)) ;; itemdat 0800: 63 61 6e 20 62 65 20 61 20 73 74 72 69 6e 67 2c can be a string, 0810: 20 6c 69 73 74 20 6f 72 20 23 66 0a 09 09 20 28 list or #f... ( 0820: 69 74 65 6d 73 20 20 20 20 20 20 20 28 74 65 73 items (tes 0830: 74 73 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 ts:testqueue-get 0840: 2d 69 74 65 6d 73 20 20 20 20 20 20 74 65 73 74 -items test 0850: 2d 72 65 63 6f 72 64 29 29 0a 09 09 20 28 69 74 -record))... (it 0860: 65 6d 2d 70 61 74 68 20 20 20 28 69 74 65 6d 2d em-path (item- 0870: 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 list->path itemd 0880: 61 74 29 29 0a 09 09 20 28 6e 65 77 74 61 6c 20 at))... (newtal 0890: 20 20 20 20 20 28 61 70 70 65 6e 64 20 74 61 6c (append tal 08a0: 20 28 6c 69 73 74 20 68 65 64 29 29 29 0a 09 09 (list hed)))... 08b0: 20 28 72 65 67 66 75 6c 6c 20 20 20 20 20 28 3e (regfull (> 08c0: 20 28 6c 65 6e 67 74 68 20 72 65 67 29 20 72 65 (length reg) re 08d0: 67 6c 65 6e 29 29 29 0a 09 20 20 20 20 3b 3b 20 glen))).. ;; 08e0: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 72 (if (> (length r 08f0: 65 67 29 20 31 30 29 0a 09 20 20 20 20 3b 3b 20 eg) 10).. ;; 0900: 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin.. 0910: 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 20 74 ;; (set! t 0920: 61 6c 20 28 63 6f 6e 73 20 68 65 64 20 74 61 6c al (cons hed tal 0930: 29 29 0a 09 20 20 20 20 3b 3b 20 20 20 20 20 20 )).. ;; 0940: 20 28 73 65 74 21 20 68 65 64 20 28 63 61 72 20 (set! hed (car 0950: 72 65 67 29 29 0a 09 20 20 20 20 3b 3b 20 20 20 reg)).. ;; 0960: 20 20 20 20 28 73 65 74 21 20 72 65 67 20 28 63 (set! reg (c 0970: 64 72 20 72 65 67 29 29 0a 09 20 20 20 20 3b 3b dr reg)).. ;; 0980: 20 20 20 20 20 20 20 28 73 65 74 21 20 6e 65 77 (set! new 0990: 74 61 6c 20 74 61 6c 29 29 29 0a 09 20 20 20 20 tal tal))).. 09a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 0a 09 (debug:print 6.. 09b0: 09 09 20 22 74 65 73 74 2d 6e 61 6d 65 3a 20 22 .. "test-name: " 09c0: 20 74 65 73 74 2d 6e 61 6d 65 0a 09 09 09 20 22 test-name.... " 09d0: 5c 6e 20 20 68 65 64 3a 20 20 20 20 20 20 20 20 \n hed: 09e0: 20 22 20 68 65 64 0a 09 09 09 20 22 5c 6e 20 20 " hed.... "\n 09f0: 69 74 65 6d 64 61 74 3a 20 20 20 20 20 22 20 69 itemdat: " i 0a00: 74 65 6d 64 61 74 0a 09 09 09 20 22 5c 6e 20 20 temdat.... "\n 0a10: 69 74 65 6d 73 3a 20 20 20 20 20 20 20 22 20 69 items: " i 0a20: 74 65 6d 73 0a 09 09 09 20 22 5c 6e 20 20 69 74 tems.... "\n it 0a30: 65 6d 2d 70 61 74 68 3a 20 20 20 22 20 69 74 65 em-path: " ite 0a40: 6d 2d 70 61 74 68 0a 09 09 09 20 22 5c 6e 20 20 m-path.... "\n 0a50: 77 61 69 74 6f 6e 73 3a 20 20 20 20 20 22 20 77 waitons: " w 0a60: 61 69 74 6f 6e 73 0a 09 09 09 20 22 5c 6e 20 20 aitons.... "\n 0a70: 6e 75 6d 2d 72 65 74 72 69 65 73 3a 20 22 20 6e num-retries: " n 0a80: 75 6d 2d 72 65 74 72 69 65 73 0a 09 09 09 20 22 um-retries.... " 0a90: 5c 6e 20 20 74 61 6c 3a 20 20 20 20 20 20 20 20 \n tal: 0aa0: 20 22 20 74 61 6c 0a 09 09 09 20 22 5c 6e 20 20 " tal.... "\n 0ab0: 72 65 72 75 6e 73 3a 20 20 20 20 20 20 22 20 72 reruns: " r 0ac0: 65 72 75 6e 73 29 0a 0a 09 20 20 20 20 3b 3b 20 eruns)... ;; 0ad0: 63 68 65 63 6b 20 66 6f 72 20 68 65 64 20 69 6e check for hed in 0ae0: 20 77 61 69 74 6f 6e 73 20 3d 3e 20 74 68 69 73 waitons => this 0af0: 20 77 6f 75 6c 64 20 62 65 20 63 69 72 63 75 6c would be circul 0b00: 61 72 2c 20 72 65 6d 6f 76 65 20 69 74 20 61 6e ar, remove it an 0b10: 64 20 69 73 73 75 65 20 61 6e 0a 09 20 20 20 20 d issue an.. 0b20: 3b 3b 20 65 72 72 6f 72 0a 09 20 20 20 20 28 69 ;; error.. (i 0b30: 66 20 28 6d 65 6d 62 65 72 20 74 65 73 74 2d 6e f (member test-n 0b40: 61 6d 65 20 77 61 69 74 6f 6e 73 29 0a 09 09 28 ame waitons)...( 0b50: 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 begin... (debug 0b60: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR: 0b70: 20 74 65 73 74 20 22 20 74 65 73 74 2d 6e 61 6d test " test-nam 0b80: 65 20 22 20 68 61 73 20 6c 69 73 74 65 64 20 69 e " has listed i 0b90: 74 73 65 6c 66 20 61 73 20 61 20 77 61 69 74 6f tself as a waito 0ba0: 6e 2c 20 70 6c 65 61 73 65 20 63 6f 72 72 65 63 n, please correc 0bb0: 74 20 74 68 69 73 21 22 29 0a 09 09 20 20 28 73 t this!")... (s 0bc0: 65 74 21 20 77 61 69 74 6f 6e 20 28 66 69 6c 74 et! waiton (filt 0bd0: 65 72 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e er (lambda (x)(n 0be0: 6f 74 20 28 65 71 75 61 6c 3f 20 78 20 68 65 64 ot (equal? x hed 0bf0: 29 29 29 20 77 61 69 74 6f 6e 73 29 29 29 29 0a ))) waitons)))). 0c00: 0a 09 20 20 20 20 28 63 6f 6e 64 20 3b 3b 20 4f .. (cond ;; O 0c10: 55 54 45 52 20 43 4f 4e 44 0a 09 20 20 20 20 20 UTER COND.. 0c20: 28 28 6e 6f 74 20 69 74 65 6d 73 29 20 3b 3b 20 ((not items) ;; 0c30: 77 68 65 6e 20 66 61 6c 73 65 20 74 68 65 20 74 when false the t 0c40: 65 73 74 20 69 73 20 6f 6b 20 74 6f 20 62 65 20 est is ok to be 0c50: 68 61 6e 64 65 64 20 6f 66 66 20 74 6f 20 6c 61 handed off to la 0c60: 75 6e 63 68 20 28 62 75 74 20 6e 6f 74 20 62 65 unch (but not be 0c70: 66 6f 72 65 29 0a 09 20 20 20 20 20 20 28 69 66 fore).. (if 0c80: 20 28 61 6e 64 20 28 6e 6f 74 20 28 74 65 73 74 (and (not (test 0c90: 73 3a 6d 61 74 63 68 20 74 65 73 74 2d 70 61 74 s:match test-pat 0ca0: 74 73 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 ts (tests:testqu 0cb0: 65 75 65 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 eue-get-testname 0cc0: 20 74 65 73 74 2d 72 65 63 6f 72 64 29 20 69 74 test-record) it 0cd0: 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 20 20 em-path)).. 0ce0: 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 (not ( 0cf0: 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 20 20 null? tal))).. 0d00: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 (loop (c 0d10: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal) 0d20: 20 72 65 67 20 72 65 72 75 6e 73 29 29 0a 09 20 reg reruns)).. 0d30: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e (let* ((run 0d40: 2d 6c 69 6d 69 74 73 2d 69 6e 66 6f 20 20 20 20 -limits-info 0d50: 20 20 20 20 20 28 72 75 6e 73 3a 63 61 6e 2d 72 (runs:can-r 0d60: 75 6e 2d 6d 6f 72 65 2d 74 65 73 74 73 20 74 65 un-more-tests te 0d70: 73 74 2d 72 65 63 6f 72 64 20 6d 61 78 2d 63 6f st-record max-co 0d80: 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 73 29 29 20 ncurrent-jobs)) 0d90: 3b 3b 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 74 ;; look at the t 0da0: 65 73 74 20 6a 6f 62 67 72 6f 75 70 20 61 6e 64 est jobgroup and 0db0: 20 74 6f 74 20 6a 6f 62 73 20 72 75 6e 6e 69 6e tot jobs runnin 0dc0: 67 0a 09 09 20 20 20 20 20 28 68 61 76 65 2d 72 g... (have-r 0dd0: 65 73 6f 75 72 63 65 73 20 20 20 20 20 20 20 20 esources 0de0: 20 20 28 63 61 72 20 72 75 6e 2d 6c 69 6d 69 74 (car run-limit 0df0: 73 2d 69 6e 66 6f 29 29 0a 09 09 20 20 20 20 20 s-info))... 0e00: 28 6e 75 6d 2d 72 75 6e 6e 69 6e 67 20 20 20 20 (num-running 0e10: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d 72 (list-r 0e20: 65 66 20 72 75 6e 2d 6c 69 6d 69 74 73 2d 69 6e ef run-limits-in 0e30: 66 6f 20 31 29 29 0a 09 09 20 20 20 20 20 28 6e fo 1))... (n 0e40: 75 6d 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f um-running-in-jo 0e50: 62 67 72 6f 75 70 20 28 6c 69 73 74 2d 72 65 66 bgroup (list-ref 0e60: 20 72 75 6e 2d 6c 69 6d 69 74 73 2d 69 6e 66 6f run-limits-info 0e70: 20 32 29 29 0a 09 09 20 20 20 20 20 28 6d 61 78 2))... (max 0e80: 2d 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 73 -concurrent-jobs 0e90: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 72 (list-ref r 0ea0: 75 6e 2d 6c 69 6d 69 74 73 2d 69 6e 66 6f 20 33 un-limits-info 3 0eb0: 29 29 0a 09 09 20 20 20 20 20 28 6a 6f 62 2d 67 ))... (job-g 0ec0: 72 6f 75 70 2d 6c 69 6d 69 74 20 20 20 20 20 20 roup-limit 0ed0: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 72 75 6e (list-ref run 0ee0: 2d 6c 69 6d 69 74 73 2d 69 6e 66 6f 20 34 29 29 -limits-info 4)) 0ef0: 0a 09 09 20 20 20 20 20 28 70 72 65 72 65 71 73 ... (prereqs 0f00: 2d 6e 6f 74 2d 6d 65 74 20 20 20 20 20 20 20 20 -not-met 0f10: 20 28 64 62 3a 67 65 74 2d 70 72 65 72 65 71 73 (db:get-prereqs 0f20: 2d 6e 6f 74 2d 6d 65 74 20 72 75 6e 2d 69 64 20 -not-met run-id 0f30: 77 61 69 74 6f 6e 73 20 69 74 65 6d 2d 70 61 74 waitons item-pat 0f40: 68 20 6d 6f 64 65 3a 20 74 65 73 74 6d 6f 64 65 h mode: testmode 0f50: 29 29 0a 09 09 20 20 20 20 20 28 66 61 69 6c 73 ))... (fails 0f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0f70: 20 20 20 28 72 75 6e 73 3a 63 61 6c 63 2d 66 61 (runs:calc-fa 0f80: 69 6c 73 20 70 72 65 72 65 71 73 2d 6e 6f 74 2d ils prereqs-not- 0f90: 6d 65 74 29 29 0a 09 09 20 20 20 20 20 28 6e 6f met))... (no 0fa0: 6e 2d 63 6f 6d 70 6c 65 74 65 64 20 20 20 20 20 n-completed 0fb0: 20 20 20 20 20 20 28 72 75 6e 73 3a 63 61 6c 63 (runs:calc 0fc0: 2d 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 20 70 -not-completed p 0fd0: 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 29 rereqs-not-met)) 0fe0: 29 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 )...(debug:print 0ff0: 2d 69 6e 66 6f 20 38 20 22 68 61 76 65 2d 72 65 -info 8 "have-re 1000: 73 6f 75 72 63 65 73 3a 20 22 20 68 61 76 65 2d sources: " have- 1010: 72 65 73 6f 75 72 63 65 73 20 22 20 70 72 65 72 resources " prer 1020: 65 71 73 2d 6e 6f 74 2d 6d 65 74 3a 20 22 20 0a eqs-not-met: " . 1030: 09 09 09 09 20 20 28 73 74 72 69 6e 67 2d 69 6e .... (string-in 1040: 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 20 tersperse ..... 1050: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda ( 1060: 74 29 0a 09 09 09 09 09 20 20 28 69 66 20 28 76 t)...... (if (v 1070: 65 63 74 6f 72 3f 20 74 29 0a 09 09 09 09 09 20 ector? t)...... 1080: 20 20 20 20 20 28 63 6f 6e 63 20 28 64 62 3a 74 (conc (db:t 1090: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 29 est-get-state t) 10a0: 20 22 2f 22 20 28 64 62 3a 74 65 73 74 2d 67 65 "/" (db:test-ge 10b0: 74 2d 73 74 61 74 75 73 20 74 29 29 0a 09 09 09 t-status t)).... 10c0: 09 09 20 20 20 20 20 20 28 63 6f 6e 63 20 22 20 .. (conc " 10d0: 57 41 52 4e 49 4e 47 3a 20 74 20 69 73 20 6e 6f WARNING: t is no 10e0: 74 20 61 20 76 65 63 74 6f 72 3d 22 20 74 20 29 t a vector=" t ) 10f0: 29 29 0a 09 09 09 09 09 70 72 65 72 65 71 73 2d ))......prereqs- 1100: 6e 6f 74 2d 6d 65 74 29 20 22 2c 20 22 29 20 22 not-met) ", ") " 1110: 20 66 61 69 6c 73 3a 20 22 20 66 61 69 6c 73 29 fails: " fails) 1120: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ...(debug:print- 1130: 69 6e 66 6f 20 34 20 22 68 65 64 3d 22 20 68 65 info 4 "hed=" he 1140: 64 20 22 5c 6e 20 20 74 65 73 74 2d 72 65 63 6f d "\n test-reco 1150: 72 64 3d 22 20 74 65 73 74 2d 72 65 63 6f 72 64 rd=" test-record 1160: 20 22 5c 6e 20 20 74 65 73 74 2d 6e 61 6d 65 3a "\n test-name: 1170: 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 5c 6e " test-name "\n 1180: 20 20 69 74 65 6d 2d 70 61 74 68 3a 20 22 20 69 item-path: " i 1190: 74 65 6d 2d 70 61 74 68 20 22 5c 6e 20 20 74 65 tem-path "\n te 11a0: 73 74 2d 70 61 74 74 73 3a 20 22 20 74 65 73 74 st-patts: " test 11b0: 2d 70 61 74 74 73 29 0a 0a 09 09 3b 3b 20 44 6f -patts)....;; Do 11c0: 6e 27 74 20 6b 6e 6f 77 20 61 74 20 74 68 69 73 n't know at this 11d0: 20 74 69 6d 65 20 69 66 20 74 68 65 20 74 65 73 time if the tes 11e0: 74 20 68 61 76 65 20 62 65 65 6e 20 6c 61 75 6e t have been laun 11f0: 63 68 65 64 20 61 74 20 73 6f 6d 65 20 74 69 6d ched at some tim 1200: 65 20 69 6e 20 74 68 65 20 70 61 73 74 0a 09 09 e in the past... 1210: 3b 3b 20 69 2e 65 2e 20 69 73 20 74 68 69 73 20 ;; i.e. is this 1220: 61 20 72 65 2d 6c 61 75 6e 63 68 3f 0a 09 09 28 a re-launch?...( 1230: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info 1240: 20 34 20 22 72 75 6e 2d 6c 69 6d 69 74 73 2d 69 4 "run-limits-i 1250: 6e 66 6f 20 3d 20 22 20 72 75 6e 2d 6c 69 6d 69 nfo = " run-limi 1260: 74 73 2d 69 6e 66 6f 29 0a 09 09 28 63 6f 6e 64 ts-info)...(cond 1270: 20 3b 3b 20 49 4e 4e 45 52 20 43 4f 4e 44 20 23 ;; INNER COND # 1280: 31 20 66 6f 72 20 61 20 6c 61 75 6e 63 68 61 62 1 for a launchab 1290: 6c 65 20 74 65 73 74 0a 09 09 20 3b 3b 20 43 68 le test... ;; Ch 12a0: 65 63 6b 20 69 74 65 6d 20 70 61 74 68 20 61 67 eck item path ag 12b0: 61 69 6e 73 74 20 69 74 65 6d 2d 70 61 74 74 73 ainst item-patts 12c0: 0a 09 09 20 28 28 6e 6f 74 20 28 74 65 73 74 73 ... ((not (tests 12d0: 3a 6d 61 74 63 68 20 74 65 73 74 2d 70 61 74 74 :match test-patt 12e0: 73 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 s (tests:testque 12f0: 75 65 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 ue-get-testname 1300: 74 65 73 74 2d 72 65 63 6f 72 64 29 20 69 74 65 test-record) ite 1310: 6d 2d 70 61 74 68 29 29 20 3b 3b 20 54 68 69 73 m-path)) ;; This 1320: 20 74 65 73 74 2f 69 74 65 6d 70 61 74 68 20 69 test/itempath i 1330: 73 20 6e 6f 74 20 74 6f 20 62 65 20 72 75 6e 0a s not to be run. 1340: 09 09 20 20 3b 3b 20 65 6c 73 65 20 74 68 65 20 .. ;; else the 1350: 72 75 6e 20 69 73 20 73 74 75 63 6b 2c 20 74 65 run is stuck, te 1360: 6d 70 6f 72 61 72 69 6c 79 20 6f 72 20 70 65 72 mporarily or per 1370: 6d 61 6e 65 6e 74 6c 79 0a 09 09 20 20 3b 3b 20 manently... ;; 1380: 62 75 74 20 73 68 6f 75 6c 64 20 63 68 65 63 6b but should check 1390: 20 69 66 20 69 74 20 69 73 20 64 75 65 20 74 6f if it is due to 13a0: 20 6c 61 63 6b 20 6f 66 20 72 65 73 6f 75 72 63 lack of resourc 13b0: 65 73 20 76 73 2e 20 70 72 65 72 65 71 75 69 73 es vs. prerequis 13c0: 69 74 65 73 0a 09 09 20 20 28 64 65 62 75 67 3a ites... (debug: 13d0: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 53 6b print-info 1 "Sk 13e0: 69 70 70 69 6e 67 20 22 20 28 74 65 73 74 73 3a ipping " (tests: 13f0: 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 74 65 testqueue-get-te 1400: 73 74 6e 61 6d 65 20 74 65 73 74 2d 72 65 63 6f stname test-reco 1410: 72 64 29 20 22 20 22 20 69 74 65 6d 2d 70 61 74 rd) " " item-pat 1420: 68 20 22 20 61 73 20 69 74 20 64 6f 65 73 6e 27 h " as it doesn' 1430: 74 20 6d 61 74 63 68 20 22 20 74 65 73 74 2d 70 t match " test-p 1440: 61 74 74 73 29 0a 09 09 20 20 3b 3b 20 28 74 68 atts)... ;; (th 1450: 72 65 61 64 2d 73 6c 65 65 70 21 20 2a 67 6c 6f read-sleep! *glo 1460: 62 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 09 20 20 bal-delta*)... 1470: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null? 1480: 74 61 6c 29 29 0a 09 09 20 20 20 20 20 20 28 6c tal))... (l 1490: 6f 6f 70 20 28 72 75 6e 73 3a 71 75 65 75 65 2d oop (runs:queue- 14a0: 6e 65 78 74 2d 68 65 64 20 74 61 6c 20 72 65 67 next-hed tal reg 14b0: 20 72 65 67 6c 65 6e 20 72 65 67 66 75 6c 6c 29 reglen regfull) 14c0: 0a 09 09 09 20 20 20 20 28 72 75 6e 73 3a 71 75 .... (runs:qu 14d0: 65 75 65 2d 6e 65 78 74 2d 74 61 6c 20 74 61 6c eue-next-tal tal 14e0: 20 72 65 67 20 72 65 67 6c 65 6e 20 72 65 67 66 reg reglen regf 14f0: 75 6c 6c 29 0a 09 09 09 20 20 20 20 28 72 75 6e ull).... (run 1500: 73 3a 71 75 65 75 65 2d 6e 65 78 74 2d 72 65 67 s:queue-next-reg 1510: 20 74 61 6c 20 72 65 67 20 72 65 67 6c 65 6e 20 tal reg reglen 1520: 72 65 67 66 75 6c 6c 29 0a 09 09 09 20 20 20 20 regfull).... 1530: 72 65 72 75 6e 73 29 29 29 0a 09 09 20 3b 3b 20 reruns)))... ;; 1540: 52 65 67 69 73 74 72 79 20 68 61 73 20 62 65 65 Registry has bee 1550: 6e 20 73 74 61 72 74 65 64 20 66 6f 72 20 74 68 n started for th 1560: 69 73 20 74 65 73 74 20 62 75 74 20 68 61 73 20 is test but has 1570: 6e 6f 74 20 79 65 74 20 63 6f 6d 70 6c 65 74 65 not yet complete 1580: 64 0a 09 09 20 3b 3b 20 74 68 69 73 20 73 68 6f d... ;; this sho 1590: 75 6c 64 20 62 65 20 72 61 72 65 2c 20 74 68 65 uld be rare, the 15a0: 20 63 61 73 65 20 77 68 65 72 65 20 74 68 65 72 case where ther 15b0: 65 20 61 72 65 20 6f 6e 6c 79 20 61 20 63 6f 75 e are only a cou 15c0: 70 6c 65 20 6f 66 20 74 65 73 74 73 20 61 6e 64 ple of tests and 15d0: 20 74 68 65 20 64 62 20 69 73 20 73 6c 6f 77 0a the db is slow. 15e0: 09 09 20 3b 3b 20 64 65 6c 61 79 20 61 20 73 68 .. ;; delay a sh 15f0: 6f 72 74 20 77 68 69 6c 65 20 61 6e 64 20 63 6f ort while and co 1600: 6e 74 69 6e 75 65 0a 09 09 20 3b 3b 20 28 28 65 ntinue... ;; ((e 1610: 71 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 q? (hash-table-r 1620: 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 2d ef/default test- 1630: 72 65 67 69 73 74 72 79 20 28 72 75 6e 73 3a 6d registry (runs:m 1640: 61 6b 65 2d 66 75 6c 6c 2d 74 65 73 74 2d 6e 61 ake-full-test-na 1650: 6d 65 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 me test-name ite 1660: 6d 2d 70 61 74 68 29 20 23 66 29 20 27 73 74 61 m-path) #f) 'sta 1670: 72 74 29 0a 09 09 20 3b 3b 20 20 28 74 68 72 65 rt)... ;; (thre 1680: 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 31 29 0a ad-sleep! 0.01). 1690: 09 09 20 3b 3b 20 20 28 6c 6f 6f 70 20 28 63 61 .. ;; (loop (ca 16a0: 72 20 6e 65 77 74 61 6c 29 28 63 64 72 20 6e 65 r newtal)(cdr ne 16b0: 77 74 61 6c 29 20 72 65 72 75 6e 73 29 29 0a 09 wtal) reruns)).. 16c0: 09 20 3b 3b 20 63 6f 75 6e 74 20 6e 75 6d 62 65 . ;; count numbe 16d0: 72 20 6f 66 20 27 64 6f 6e 65 2c 20 69 66 20 6d r of 'done, if m 16e0: 6f 72 65 20 74 68 61 6e 20 31 30 30 20 74 68 65 ore than 100 the 16f0: 6e 20 73 6b 69 70 20 6f 6e 20 74 68 72 6f 75 67 n skip on throug 1700: 68 2e 0a 09 09 20 28 28 6e 6f 74 20 28 68 61 73 h.... ((not (has 1710: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa 1720: 75 6c 74 20 74 65 73 74 2d 72 65 67 69 73 74 72 ult test-registr 1730: 79 20 28 72 75 6e 73 3a 6d 61 6b 65 2d 66 75 6c y (runs:make-ful 1740: 6c 2d 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 l-test-name test 1750: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path) 1760: 20 23 66 29 29 20 3b 3b 20 29 20 3b 3b 20 74 6f #f)) ;; ) ;; to 1770: 6f 20 6d 61 6e 79 20 63 68 61 6e 67 65 73 20 72 o many changes r 1780: 65 71 75 69 72 65 64 2e 20 49 6d 70 6c 65 6d 65 equired. Impleme 1790: 6e 74 20 6c 61 74 65 72 2e 0a 09 09 20 20 28 64 nt later.... (d 17a0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info 17b0: 34 20 22 50 72 65 2d 72 65 67 69 73 74 65 72 69 4 "Pre-registeri 17c0: 6e 67 20 74 65 73 74 20 22 20 74 65 73 74 2d 6e ng test " test-n 17d0: 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 ame "/" item-pat 17e0: 68 20 22 20 74 6f 20 63 72 65 61 74 65 20 70 6c h " to create pl 17f0: 61 63 65 68 6f 6c 64 65 72 22 20 29 0a 09 09 20 aceholder" )... 1800: 20 28 6c 65 74 20 28 28 74 68 20 28 6d 61 6b 65 (let ((th (make 1810: 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 -thread (lambda 1820: 28 29 0a 09 09 09 09 09 20 20 20 28 6d 75 74 65 ()...... (mute 1830: 78 2d 6c 6f 63 6b 21 20 72 65 67 69 73 74 72 79 x-lock! registry 1840: 2d 6d 75 74 65 78 29 0a 09 09 09 09 09 20 20 20 -mutex)...... 1850: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set! 1860: 20 74 65 73 74 2d 72 65 67 69 73 74 72 79 20 28 test-registry ( 1870: 72 75 6e 73 3a 6d 61 6b 65 2d 66 75 6c 6c 2d 74 runs:make-full-t 1880: 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 est-name test-na 1890: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 20 27 73 me item-path) 's 18a0: 74 61 72 74 29 0a 09 09 09 09 09 20 20 20 28 6d tart)...... (m 18b0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 72 65 67 utex-unlock! reg 18c0: 69 73 74 72 79 2d 6d 75 74 65 78 29 0a 09 09 09 istry-mutex).... 18d0: 09 09 20 20 20 3b 3b 20 49 66 20 68 61 76 65 6e .. ;; If haven 18e0: 27 74 20 64 6f 6e 65 20 69 74 20 62 65 66 6f 72 't done it befor 18f0: 65 20 72 65 67 69 73 74 65 72 20 61 20 74 6f 70 e register a top 1900: 20 6c 65 76 65 6c 20 74 65 73 74 20 69 66 20 74 level test if t 1910: 68 69 73 20 69 73 20 61 6e 20 69 74 65 6d 69 7a his is an itemiz 1920: 65 64 20 74 65 73 74 0a 09 09 09 09 09 20 20 20 ed test...... 1930: 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 28 68 (if (not (eq? (h 1940: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de 1950: 66 61 75 6c 74 20 74 65 73 74 2d 72 65 67 69 73 fault test-regis 1960: 74 72 79 20 28 72 75 6e 73 3a 6d 61 6b 65 2d 66 try (runs:make-f 1970: 75 6c 6c 2d 74 65 73 74 2d 6e 61 6d 65 20 74 65 ull-test-name te 1980: 73 74 2d 6e 61 6d 65 20 22 22 29 20 23 66 29 20 st-name "") #f) 1990: 27 64 6f 6e 65 29 29 0a 09 09 09 09 09 20 20 20 'done))...... 19a0: 20 20 20 20 28 63 64 62 3a 74 65 73 74 73 2d 72 (cdb:tests-r 19b0: 65 67 69 73 74 65 72 2d 74 65 73 74 20 2a 72 75 egister-test *ru 19c0: 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 2d 69 64 20 nremote* run-id 19d0: 74 65 73 74 2d 6e 61 6d 65 20 22 22 29 29 0a 09 test-name "")).. 19e0: 09 09 09 09 20 20 20 28 63 64 62 3a 74 65 73 74 .... (cdb:test 19f0: 73 2d 72 65 67 69 73 74 65 72 2d 74 65 73 74 20 s-register-test 1a00: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 2d *runremote* run- 1a10: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite 1a20: 6d 2d 70 61 74 68 29 0a 09 09 09 09 09 20 20 20 m-path)...... 1a30: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 72 65 67 (mutex-lock! reg 1a40: 69 73 74 72 79 2d 6d 75 74 65 78 29 0a 09 09 09 istry-mutex).... 1a50: 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 .. (hash-table 1a60: 2d 73 65 74 21 20 74 65 73 74 2d 72 65 67 69 73 -set! test-regis 1a70: 74 72 79 20 28 72 75 6e 73 3a 6d 61 6b 65 2d 66 try (runs:make-f 1a80: 75 6c 6c 2d 74 65 73 74 2d 6e 61 6d 65 20 74 65 ull-test-name te 1a90: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat 1aa0: 68 29 20 27 64 6f 6e 65 29 0a 09 09 09 09 09 20 h) 'done)...... 1ab0: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock! 1ac0: 20 72 65 67 69 73 74 72 79 2d 6d 75 74 65 78 29 registry-mutex) 1ad0: 29 0a 09 09 09 09 09 20 28 63 6f 6e 63 20 74 65 )...... (conc te 1ae0: 73 74 2d 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d st-name "/" item 1af0: 2d 70 61 74 68 29 29 29 29 0a 09 09 20 20 20 20 -path))))... 1b00: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 (thread-start! t 1b10: 68 29 29 0a 09 09 20 20 28 72 75 6e 73 3a 73 68 h))... (runs:sh 1b20: 72 69 6e 6b 2d 63 61 6e 2d 72 75 6e 2d 6d 6f 72 rink-can-run-mor 1b30: 65 2d 74 65 73 74 73 2d 63 6f 75 6e 74 29 20 20 e-tests-count) 1b40: 20 3b 3b 20 44 45 4c 41 59 20 54 57 45 41 4b 45 ;; DELAY TWEAKE 1b50: 52 20 28 73 74 69 6c 6c 20 6e 65 65 64 65 64 3f R (still needed? 1b60: 29 0a 09 09 20 20 28 69 66 20 28 61 6e 64 20 28 )... (if (and ( 1b70: 6e 75 6c 6c 3f 20 74 61 6c 29 28 6e 75 6c 6c 3f null? tal)(null? 1b80: 20 72 65 67 29 29 0a 09 09 20 20 20 20 20 20 28 reg))... ( 1b90: 6c 6f 6f 70 20 68 65 64 20 74 61 6c 20 72 65 67 loop hed tal reg 1ba0: 20 72 65 72 75 6e 73 29 0a 09 09 20 20 20 20 20 reruns)... 1bb0: 20 28 6c 6f 6f 70 20 28 72 75 6e 73 3a 71 75 65 (loop (runs:que 1bc0: 75 65 2d 6e 65 78 74 2d 68 65 64 20 74 61 6c 20 ue-next-hed tal 1bd0: 72 65 67 20 72 65 67 6c 65 6e 20 72 65 67 66 75 reg reglen regfu 1be0: 6c 6c 29 0a 09 09 09 20 20 20 20 28 72 75 6e 73 ll).... (runs 1bf0: 3a 71 75 65 75 65 2d 6e 65 78 74 2d 74 61 6c 20 :queue-next-tal 1c00: 74 61 6c 20 72 65 67 20 72 65 67 6c 65 6e 20 72 tal reg reglen r 1c10: 65 67 66 75 6c 6c 29 0a 09 09 09 20 20 20 20 28 egfull).... ( 1c20: 6c 65 74 20 28 28 6e 65 77 6c 20 28 61 70 70 65 let ((newl (appe 1c30: 6e 64 20 72 65 67 20 28 6c 69 73 74 20 68 65 64 nd reg (list hed 1c40: 29 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 69 )))).... (i 1c50: 66 20 72 65 67 66 75 6c 6c 20 0a 09 09 09 09 20 f regfull ..... 1c60: 20 28 63 64 72 20 6e 65 77 6c 29 0a 09 09 09 09 (cdr newl)..... 1c70: 20 20 6e 65 77 6c 29 29 0a 09 09 09 20 20 20 20 newl)).... 1c80: 72 65 72 75 6e 73 29 29 29 0a 09 09 20 3b 3b 20 reruns)))... ;; 1c90: 41 74 20 74 68 69 73 20 70 6f 69 6e 74 20 68 65 At this point he 1ca0: 64 20 74 65 73 74 20 72 65 67 69 73 74 72 61 74 d test registrat 1cb0: 69 6f 6e 20 6d 75 73 74 20 62 65 20 63 6f 6d 70 ion must be comp 1cc0: 6c 65 74 65 64 2e 0a 09 09 20 28 28 65 71 3f 20 leted.... ((eq? 1cd0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/ 1ce0: 64 65 66 61 75 6c 74 20 74 65 73 74 2d 72 65 67 default test-reg 1cf0: 69 73 74 72 79 20 28 72 75 6e 73 3a 6d 61 6b 65 istry (runs:make 1d00: 2d 66 75 6c 6c 2d 74 65 73 74 2d 6e 61 6d 65 20 -full-test-name 1d10: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 test-name item-p 1d20: 61 74 68 29 20 23 66 29 0a 09 09 20 20 20 20 20 ath) #f)... 1d30: 20 20 27 73 74 61 72 74 29 0a 09 09 20 20 28 64 'start)... (d 1d40: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info 1d50: 30 20 22 57 61 69 74 69 6e 67 20 6f 6e 20 74 65 0 "Waiting on te 1d60: 73 74 20 72 65 67 69 73 74 72 61 74 69 6f 6e 28 st registration( 1d70: 73 29 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e s): " (string-in 1d80: 74 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 tersperse ...... 1d90: 09 09 09 09 20 20 20 28 66 69 6c 74 65 72 20 28 .... (filter ( 1da0: 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 09 lambda (x)...... 1db0: 09 09 09 09 09 20 20 20 20 20 28 65 71 3f 20 28 ..... (eq? ( 1dc0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d 1dd0: 65 66 61 75 6c 74 20 74 65 73 74 2d 72 65 67 69 efault test-regi 1de0: 73 74 72 79 20 78 20 23 66 29 20 27 73 74 61 72 stry x #f) 'star 1df0: 74 29 29 0a 09 09 09 09 09 09 09 09 09 09 20 20 t))........... 1e00: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key 1e10: 73 20 74 65 73 74 2d 72 65 67 69 73 74 72 79 29 s test-registry) 1e20: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 22 2c ).......... ", 1e30: 20 22 29 29 0a 09 09 20 20 28 74 68 72 65 61 64 "))... (thread 1e40: 2d 73 6c 65 65 70 21 20 30 2e 31 29 0a 09 09 20 -sleep! 0.1)... 1e50: 20 28 6c 6f 6f 70 20 68 65 64 20 74 61 6c 20 72 (loop hed tal r 1e60: 65 67 20 72 65 72 75 6e 73 29 29 0a 09 09 20 28 eg reruns))... ( 1e70: 28 6e 6f 74 20 68 61 76 65 2d 72 65 73 6f 75 72 (not have-resour 1e80: 63 65 73 29 20 3b 3b 20 73 69 6d 70 6c 79 20 74 ces) ;; simply t 1e90: 72 79 20 61 67 61 69 6e 20 61 66 74 65 72 20 77 ry again after w 1ea0: 61 69 74 69 6e 67 20 61 20 73 65 63 6f 6e 64 0a aiting a second. 1eb0: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print 1ec0: 2d 69 6e 66 6f 20 31 20 22 6e 6f 20 72 65 73 6f -info 1 "no reso 1ed0: 75 72 63 65 73 20 74 6f 20 72 75 6e 20 6e 65 77 urces to run new 1ee0: 20 74 65 73 74 73 2c 20 77 61 69 74 69 6e 67 20 tests, waiting 1ef0: 2e 2e 2e 22 29 0a 09 09 20 20 3b 3b 20 48 61 76 ...")... ;; Hav 1f00: 65 20 67 6f 6e 65 20 62 61 63 6b 20 61 6e 64 20 e gone back and 1f10: 66 6f 72 74 68 20 6f 6e 20 74 68 69 73 20 62 75 forth on this bu 1f20: 74 20 64 62 20 73 74 61 72 76 61 74 69 6f 6e 20 t db starvation 1f30: 69 73 20 61 6e 20 69 73 73 75 65 2e 0a 09 09 20 is an issue.... 1f40: 20 3b 3b 20 77 61 69 74 20 6f 6e 65 20 73 65 63 ;; wait one sec 1f50: 6f 6e 64 20 62 65 66 6f 72 65 20 6c 6f 6f 6b 69 ond before looki 1f60: 6e 67 20 61 67 61 69 6e 20 74 6f 20 72 75 6e 20 ng again to run 1f70: 6a 6f 62 73 2e 0a 09 09 20 20 28 74 68 72 65 61 jobs.... (threa 1f80: 64 2d 73 6c 65 65 70 21 20 31 29 20 3b 3b 20 28 d-sleep! 1) ;; ( 1f90: 2b 20 32 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 + 2 *global-delt 1fa0: 61 2a 29 29 0a 09 09 20 20 3b 3b 20 63 6f 75 6c a*))... ;; coul 1fb0: 64 20 68 61 76 65 20 64 6f 6e 65 20 68 65 64 20 d have done hed 1fc0: 74 61 6c 20 68 65 72 65 20 62 75 74 20 64 6f 69 tal here but doi 1fd0: 6e 67 20 63 61 72 2f 63 64 72 20 6f 66 20 6e 65 ng car/cdr of ne 1fe0: 77 74 61 6c 20 74 6f 20 72 6f 74 61 74 65 20 74 wtal to rotate t 1ff0: 65 73 74 73 0a 09 09 20 20 28 6c 6f 6f 70 20 28 ests... (loop ( 2000: 63 61 72 20 6e 65 77 74 61 6c 29 28 63 64 72 20 car newtal)(cdr 2010: 6e 65 77 74 61 6c 29 20 72 65 67 20 72 65 72 75 newtal) reg reru 2020: 6e 73 29 29 0a 09 09 20 28 28 61 6e 64 20 68 61 ns))... ((and ha 2030: 76 65 2d 72 65 73 6f 75 72 63 65 73 0a 09 09 20 ve-resources... 2040: 20 20 20 20 20 20 28 6f 72 20 28 6e 75 6c 6c 3f (or (null? 2050: 20 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 prereqs-not-met 2060: 29 0a 09 09 09 20 20 20 28 61 6e 64 20 28 65 71 ).... (and (eq 2070: 3f 20 74 65 73 74 6d 6f 64 65 20 27 74 6f 70 6c ? testmode 'topl 2080: 65 76 65 6c 29 0a 09 09 09 09 28 6e 75 6c 6c 3f evel).....(null? 2090: 20 6e 6f 6e 2d 63 6f 6d 70 6c 65 74 65 64 29 29 non-completed)) 20a0: 29 29 0a 09 09 20 20 28 72 75 6e 3a 74 65 73 74 ))... (run:test 20b0: 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 6f run-id run-info 20c0: 20 6b 65 79 2d 76 61 6c 73 20 72 75 6e 6e 61 6d key-vals runnam 20d0: 65 20 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 74 e keyvallst test 20e0: 2d 72 65 63 6f 72 64 20 66 6c 61 67 73 20 23 66 -record flags #f 20f0: 29 0a 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c )... (hash-tabl 2100: 65 2d 73 65 74 21 20 74 65 73 74 2d 72 65 67 69 e-set! test-regi 2110: 73 74 72 79 20 28 72 75 6e 73 3a 6d 61 6b 65 2d stry (runs:make- 2120: 66 75 6c 6c 2d 74 65 73 74 2d 6e 61 6d 65 20 74 full-test-name t 2130: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa 2140: 74 68 29 20 27 72 75 6e 6e 69 6e 67 29 0a 09 09 th) 'running)... 2150: 20 20 28 72 75 6e 73 3a 73 68 72 69 6e 6b 2d 63 (runs:shrink-c 2160: 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d 74 65 73 74 an-run-more-test 2170: 73 2d 63 6f 75 6e 74 29 20 20 3b 3b 20 44 45 4c s-count) ;; DEL 2180: 41 59 20 54 57 45 41 4b 45 52 20 28 73 74 69 6c AY TWEAKER (stil 2190: 6c 20 6e 65 65 64 65 64 3f 29 0a 09 09 20 20 3b l needed?)... ; 21a0: 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ; (thread-sleep! 21b0: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 *global-delta*) 21c0: 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 28 6e ... (if (not (n 21d0: 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 20 20 20 ull? tal))... 21e0: 20 20 20 28 6c 6f 6f 70 20 28 72 75 6e 73 3a 71 (loop (runs:q 21f0: 75 65 75 65 2d 6e 65 78 74 2d 68 65 64 20 74 61 ueue-next-hed ta 2200: 6c 20 72 65 67 20 72 65 67 6c 65 6e 20 72 65 67 l reg reglen reg 2210: 66 75 6c 6c 29 0a 09 09 09 20 20 20 20 28 72 75 full).... (ru 2220: 6e 73 3a 71 75 65 75 65 2d 6e 65 78 74 2d 74 61 ns:queue-next-ta 2230: 6c 20 74 61 6c 20 72 65 67 20 72 65 67 6c 65 6e l tal reg reglen 2240: 20 72 65 67 66 75 6c 6c 29 0a 09 09 09 20 20 20 regfull).... 2250: 20 28 72 75 6e 73 3a 71 75 65 75 65 2d 6e 65 78 (runs:queue-nex 2260: 74 2d 72 65 67 20 74 61 6c 20 72 65 67 20 72 65 t-reg tal reg re 2270: 67 6c 65 6e 20 72 65 67 66 75 6c 6c 29 0a 09 09 glen regfull)... 2280: 09 20 20 20 20 72 65 72 75 6e 73 29 29 29 0a 09 . reruns))).. 2290: 09 20 28 65 6c 73 65 20 3b 3b 20 6d 75 73 74 20 . (else ;; must 22a0: 62 65 20 77 65 20 68 61 76 65 20 75 6e 6d 65 74 be we have unmet 22b0: 20 70 72 65 72 65 71 75 69 73 69 74 65 73 0a 09 prerequisites.. 22c0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print 22d0: 34 20 22 46 41 49 4c 53 3a 20 22 20 66 61 69 6c 4 "FAILS: " fail 22e0: 73 29 0a 09 09 20 20 3b 3b 20 49 66 20 6f 6e 65 s)... ;; If one 22f0: 20 6f 72 20 6d 6f 72 65 20 6f 66 20 74 68 65 20 or more of the 2300: 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 prereqs-not-met 2310: 61 72 65 20 46 41 49 4c 20 74 68 65 6e 20 77 65 are FAIL then we 2320: 20 63 61 6e 20 69 73 73 75 65 0a 09 09 20 20 3b can issue... ; 2330: 3b 20 61 20 6d 65 73 73 61 67 65 20 61 6e 64 20 ; a message and 2340: 64 72 6f 70 20 68 65 64 20 66 72 6f 6d 20 74 68 drop hed from th 2350: 65 20 69 74 65 6d 73 20 74 6f 20 62 65 20 70 72 e items to be pr 2360: 6f 63 65 73 73 65 64 2e 0a 09 09 20 20 28 69 66 ocessed.... (if 2370: 20 28 6e 75 6c 6c 3f 20 66 61 69 6c 73 29 0a 09 (null? fails).. 2380: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin... 2390: 09 3b 3b 20 63 6f 75 6c 64 6e 27 74 20 72 75 6e .;; couldn't run 23a0: 2c 20 74 61 6b 65 20 61 20 62 72 65 61 74 68 65 , take a breathe 23b0: 72 0a 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e r....(debug:prin 23c0: 74 2d 69 6e 66 6f 20 34 20 22 53 68 6f 75 6c 64 t-info 4 "Should 23d0: 6e 27 74 20 72 65 61 6c 6c 79 20 67 65 74 20 68 n't really get h 23e0: 65 72 65 2c 20 72 61 63 65 20 63 6f 6e 64 69 74 ere, race condit 23f0: 69 6f 6e 3f 20 55 6e 61 62 6c 65 20 74 6f 20 6c ion? Unable to l 2400: 61 75 6e 63 68 20 6d 6f 72 65 20 74 65 73 74 73 aunch more tests 2410: 20 61 74 20 74 68 69 73 20 6d 6f 6d 65 6e 74 2c at this moment, 2420: 20 6b 69 6c 6c 69 6e 67 20 74 69 6d 65 20 2e 2e killing time .. 2430: 2e 22 29 0a 09 09 09 3b 3b 20 28 74 68 72 65 61 .")....;; (threa 2440: 64 2d 73 6c 65 65 70 21 20 28 2b 20 30 2e 30 31 d-sleep! (+ 0.01 2450: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 *global-delta*) 2460: 29 20 3b 3b 20 6c 6f 6e 67 20 73 6c 65 65 70 20 ) ;; long sleep 2470: 68 65 72 65 20 2d 20 6e 6f 20 72 65 73 6f 75 72 here - no resour 2480: 63 65 73 2c 20 6d 61 79 20 61 73 20 77 65 6c 6c ces, may as well 2490: 20 62 65 20 70 61 74 69 65 6e 74 0a 09 09 09 3b be patient....; 24a0: 3b 20 77 65 20 6d 61 64 65 20 6e 65 77 20 74 61 ; we made new ta 24b0: 6c 20 62 79 20 73 74 69 63 6b 69 6e 67 20 68 65 l by sticking he 24c0: 64 20 61 74 20 74 68 65 20 62 61 63 6b 20 6f 66 d at the back of 24d0: 20 74 68 65 20 6c 69 73 74 0a 09 09 09 28 6c 6f the list....(lo 24e0: 6f 70 20 28 63 61 72 20 6e 65 77 74 61 6c 29 28 op (car newtal)( 24f0: 63 64 72 20 6e 65 77 74 61 6c 29 20 72 65 67 20 cdr newtal) reg 2500: 72 65 72 75 6e 73 29 29 0a 09 09 20 20 20 20 20 reruns))... 2510: 20 3b 3b 20 74 68 65 20 77 61 69 74 6f 6e 20 69 ;; the waiton i 2520: 73 20 46 41 49 4c 20 73 6f 20 6e 6f 20 70 6f 69 s FAIL so no poi 2530: 6e 74 20 69 6e 20 74 72 79 69 6e 67 20 74 6f 20 nt in trying to 2540: 72 75 6e 20 68 65 64 20 65 76 65 72 20 61 67 61 run hed ever aga 2550: 69 6e 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 in... (if ( 2560: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal)) 2570: 0a 09 09 09 20 20 28 69 66 20 28 76 65 63 74 6f .... (if (vecto 2580: 72 3f 20 68 65 64 29 0a 09 09 09 20 20 20 20 20 r? hed).... 2590: 20 28 62 65 67 69 6e 20 0a 09 09 09 09 28 64 65 (begin .....(de 25a0: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 57 41 52 bug:print 1 "WAR 25b0: 4e 3a 20 44 72 6f 70 70 69 6e 67 20 74 65 73 74 N: Dropping test 25c0: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get- 25d0: 74 65 73 74 6e 61 6d 65 20 68 65 64 29 20 22 2f testname hed) "/ 25e0: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 " (db:test-get-i 25f0: 74 65 6d 2d 70 61 74 68 20 68 65 64 29 0a 09 09 tem-path hed)... 2600: 09 09 09 20 20 20 20 20 22 20 66 72 6f 6d 20 74 ... " from t 2610: 68 65 20 6c 61 75 6e 63 68 20 6c 69 73 74 20 61 he launch list a 2620: 73 20 69 74 20 68 61 73 20 70 72 65 72 65 71 75 s it has prerequ 2630: 69 73 74 65 73 20 74 68 61 74 20 61 72 65 20 46 istes that are F 2640: 41 49 4c 22 29 0a 09 09 09 09 28 72 75 6e 73 3a AIL").....(runs: 2650: 73 68 72 69 6e 6b 2d 63 61 6e 2d 72 75 6e 2d 6d shrink-can-run-m 2660: 6f 72 65 2d 74 65 73 74 73 2d 63 6f 75 6e 74 29 ore-tests-count) 2670: 20 3b 3b 20 44 45 4c 41 59 20 54 57 45 41 4b 45 ;; DELAY TWEAKE 2680: 52 20 28 73 74 69 6c 6c 20 6e 65 65 64 65 64 3f R (still needed? 2690: 29 0a 09 09 09 09 3b 3b 20 28 74 68 72 65 61 64 ).....;; (thread 26a0: 2d 73 6c 65 65 70 21 20 2a 67 6c 6f 62 61 6c 2d -sleep! *global- 26b0: 64 65 6c 74 61 2a 29 0a 09 09 09 09 28 68 61 73 delta*).....(has 26c0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes 26d0: 74 2d 72 65 67 69 73 74 72 79 20 28 72 75 6e 73 t-registry (runs 26e0: 3a 6d 61 6b 65 2d 66 75 6c 6c 2d 74 65 73 74 2d :make-full-test- 26f0: 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 20 69 name test-name i 2700: 74 65 6d 2d 70 61 74 68 29 20 27 72 65 6d 6f 76 tem-path) 'remov 2710: 65 64 29 0a 09 09 09 09 28 6c 6f 6f 70 20 28 72 ed).....(loop (r 2720: 75 6e 73 3a 71 75 65 75 65 2d 6e 65 78 74 2d 68 uns:queue-next-h 2730: 65 64 20 74 61 6c 20 72 65 67 20 72 65 67 6c 65 ed tal reg regle 2740: 6e 20 72 65 67 66 75 6c 6c 29 0a 09 09 09 09 20 n regfull)..... 2750: 20 20 20 20 20 28 72 75 6e 73 3a 71 75 65 75 65 (runs:queue 2760: 2d 6e 65 78 74 2d 74 61 6c 20 74 61 6c 20 72 65 -next-tal tal re 2770: 67 20 72 65 67 6c 65 6e 20 72 65 67 66 75 6c 6c g reglen regfull 2780: 29 0a 09 09 09 09 20 20 20 20 20 20 28 72 75 6e )..... (run 2790: 73 3a 71 75 65 75 65 2d 6e 65 78 74 2d 72 65 67 s:queue-next-reg 27a0: 20 74 61 6c 20 72 65 67 20 72 65 67 6c 65 6e 20 tal reg reglen 27b0: 72 65 67 66 75 6c 6c 29 0a 09 09 09 09 20 20 20 regfull)..... 27c0: 20 20 20 28 63 6f 6e 73 20 68 65 64 20 72 65 72 (cons hed rer 27d0: 75 6e 73 29 29 29 0a 09 09 09 20 20 20 20 20 20 uns))).... 27e0: 28 62 65 67 69 6e 0a 09 09 09 09 28 64 65 62 75 (begin.....(debu 27f0: 67 3a 70 72 69 6e 74 20 31 20 22 57 41 52 4e 3a g:print 1 "WARN: 2800: 20 54 65 73 74 20 6e 6f 74 20 70 72 6f 63 65 73 Test not proces 2810: 73 65 64 20 63 6f 72 72 65 63 74 6c 79 2e 20 43 sed correctly. C 2820: 6f 75 6c 64 20 62 65 20 61 20 72 61 63 65 20 63 ould be a race c 2830: 6f 6e 64 69 74 69 6f 6e 20 69 6e 20 79 6f 75 72 ondition in your 2840: 20 74 65 73 74 20 69 6d 70 6c 65 6d 65 6e 74 61 test implementa 2850: 74 69 6f 6e 3f 20 22 20 68 65 64 29 20 3b 3b 20 tion? " hed) ;; 2860: 20 22 20 61 73 20 69 74 20 68 61 73 20 70 72 65 " as it has pre 2870: 72 65 71 75 69 73 74 65 73 20 74 68 61 74 20 61 requistes that a 2880: 72 65 20 46 41 49 4c 2e 20 28 4e 4f 54 45 3a 20 re FAIL. (NOTE: 2890: 68 65 64 20 69 73 20 6e 6f 74 20 61 20 76 65 63 hed is not a vec 28a0: 74 6f 72 29 22 29 0a 09 09 09 09 28 72 75 6e 73 tor)").....(runs 28b0: 3a 73 68 72 69 6e 6b 2d 63 61 6e 2d 72 75 6e 2d :shrink-can-run- 28c0: 6d 6f 72 65 2d 74 65 73 74 73 2d 63 6f 75 6e 74 more-tests-count 28d0: 29 20 3b 3b 20 44 45 4c 41 59 20 54 57 45 41 4b ) ;; DELAY TWEAK 28e0: 45 52 20 28 73 74 69 6c 6c 20 6e 65 65 64 65 64 ER (still needed 28f0: 3f 29 0a 09 09 09 09 3b 3b 20 28 74 68 72 65 61 ?).....;; (threa 2900: 64 2d 73 6c 65 65 70 21 20 28 2b 20 30 2e 30 31 d-sleep! (+ 0.01 2910: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 *global-delta*) 2920: 29 0a 09 09 09 09 28 6c 6f 6f 70 20 68 65 64 20 ).....(loop hed 2930: 74 61 6c 20 72 65 67 20 72 65 72 75 6e 73 29 29 tal reg reruns)) 2940: 29 29 29 29 29 29 29 20 3b 3b 20 45 4e 44 20 4f ))))))) ;; END O 2950: 46 20 49 4e 4e 45 52 20 43 4f 4e 44 0a 09 20 20 F INNER COND.. 2960: 20 20 20 0a 09 20 20 20 20 20 3b 3b 20 63 61 73 .. ;; cas 2970: 65 20 77 68 65 72 65 20 61 6e 20 69 74 65 6d 73 e where an items 2980: 20 63 61 6d 65 20 69 6e 20 61 73 20 61 20 6c 69 came in as a li 2990: 73 74 20 62 65 65 6e 20 70 72 6f 63 65 73 73 65 st been processe 29a0: 64 0a 09 20 20 20 20 20 28 28 61 6e 64 20 28 6c d.. ((and (l 29b0: 69 73 74 3f 20 69 74 65 6d 73 29 20 20 20 20 20 ist? items) 29c0: 3b 3b 20 74 68 75 73 20 77 65 20 6b 6e 6f 77 20 ;; thus we know 29d0: 6f 75 72 20 69 74 65 6d 73 20 61 72 65 20 61 6c our items are al 29e0: 72 65 61 64 79 20 63 61 6c 63 75 6c 61 74 65 64 ready calculated 29f0: 0a 09 09 20 20 20 28 6e 6f 74 20 20 20 69 74 65 ... (not ite 2a00: 6d 64 61 74 29 29 20 3b 3b 20 61 6e 64 20 6e 6f mdat)) ;; and no 2a10: 74 20 79 65 74 20 65 78 70 61 6e 64 65 64 20 69 t yet expanded i 2a20: 6e 74 6f 20 74 68 65 20 6c 69 73 74 20 6f 66 20 nto the list of 2a30: 74 68 69 6e 67 73 20 74 6f 20 62 65 20 64 6f 6e things to be don 2a40: 65 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 6e e.. (if (an 2a50: 64 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d d (debug:debug-m 2a60: 6f 64 65 20 31 29 20 3b 3b 20 28 3e 3d 20 2a 76 ode 1) ;; (>= *v 2a70: 65 72 62 6f 73 69 74 79 2a 20 31 29 0a 09 09 20 erbosity* 1)... 2a80: 20 20 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 (> (length 2a90: 20 69 74 65 6d 73 29 20 30 29 0a 09 09 20 20 20 items) 0)... 2aa0: 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 (> (length ( 2ab0: 63 61 72 20 69 74 65 6d 73 29 29 20 30 29 29 0a car items)) 0)). 2ac0: 09 09 20 20 28 70 70 20 69 74 65 6d 73 29 29 0a .. (pp items)). 2ad0: 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each 2ae0: 0a 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda 2af0: 20 28 6d 79 2d 69 74 65 6d 64 61 74 29 0a 09 09 (my-itemdat)... 2b00: 20 28 6c 65 74 2a 20 28 28 6e 65 77 2d 74 65 73 (let* ((new-tes 2b10: 74 2d 72 65 63 6f 72 64 20 28 6c 65 74 20 28 28 t-record (let (( 2b20: 6e 65 77 72 65 63 20 28 6d 61 6b 65 2d 74 65 73 newrec (make-tes 2b30: 74 73 3a 74 65 73 74 71 75 65 75 65 29 29 29 0a ts:testqueue))). 2b40: 09 09 09 09 09 20 20 20 28 76 65 63 74 6f 72 2d ..... (vector- 2b50: 63 6f 70 79 21 20 74 65 73 74 2d 72 65 63 6f 72 copy! test-recor 2b60: 64 20 6e 65 77 72 65 63 29 0a 09 09 09 09 09 20 d newrec)...... 2b70: 20 20 6e 65 77 72 65 63 29 29 0a 09 09 09 28 6d newrec))....(m 2b80: 79 2d 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 y-item-path (ite 2b90: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 6d 79 2d m-list->path my- 2ba0: 69 74 65 6d 64 61 74 29 29 29 0a 09 09 20 20 20 itemdat)))... 2bb0: 28 69 66 20 28 74 65 73 74 73 3a 6d 61 74 63 68 (if (tests:match 2bc0: 20 74 65 73 74 2d 70 61 74 74 73 20 68 65 64 20 test-patts hed 2bd0: 6d 79 2d 69 74 65 6d 2d 70 61 74 68 29 20 3b 3b my-item-path) ;; 2be0: 20 28 70 61 74 74 2d 6c 69 73 74 2d 6d 61 74 63 (patt-list-matc 2bf0: 68 20 6d 79 2d 69 74 65 6d 2d 70 61 74 68 20 69 h my-item-path i 2c00: 74 65 6d 2d 70 61 74 74 73 29 20 20 20 20 20 20 tem-patts) 2c10: 20 20 20 20 20 3b 3b 20 79 65 73 2c 20 77 65 20 ;; yes, we 2c20: 77 61 6e 74 20 74 6f 20 70 72 6f 63 65 73 73 20 want to process 2c30: 74 68 69 73 20 69 74 65 6d 2c 20 4e 4f 54 45 3a this item, NOTE: 2c40: 20 53 68 6f 75 6c 64 20 6e 6f 74 20 6e 65 65 64 Should not need 2c50: 20 74 68 69 73 20 63 68 65 63 6b 20 68 65 72 65 this check here 2c60: 21 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 !... (let 2c70: 28 28 6e 65 77 74 65 73 74 6e 61 6d 65 20 28 72 ((newtestname (r 2c80: 75 6e 73 3a 6d 61 6b 65 2d 66 75 6c 6c 2d 74 65 uns:make-full-te 2c90: 73 74 2d 6e 61 6d 65 20 68 65 64 20 6d 79 2d 69 st-name hed my-i 2ca0: 74 65 6d 2d 70 61 74 68 29 29 29 20 20 20 20 3b tem-path))) ; 2cb0: 3b 20 74 65 73 74 20 6e 61 6d 65 73 20 61 72 65 ; test names are 2cc0: 20 75 6e 69 71 75 65 20 6f 6e 20 74 65 73 74 6e unique on testn 2cd0: 61 6d 65 2f 69 74 65 6d 2d 70 61 74 68 0a 09 09 ame/item-path... 2ce0: 09 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 . (tests:testque 2cf0: 75 65 2d 73 65 74 2d 69 74 65 6d 73 21 20 20 20 ue-set-items! 2d00: 20 20 6e 65 77 2d 74 65 73 74 2d 72 65 63 6f 72 new-test-recor 2d10: 64 20 23 66 29 0a 09 09 09 20 28 74 65 73 74 73 d #f).... (tests 2d20: 3a 74 65 73 74 71 75 65 75 65 2d 73 65 74 2d 69 :testqueue-set-i 2d30: 74 65 6d 64 61 74 21 20 20 20 6e 65 77 2d 74 65 temdat! new-te 2d40: 73 74 2d 72 65 63 6f 72 64 20 6d 79 2d 69 74 65 st-record my-ite 2d50: 6d 64 61 74 29 0a 09 09 09 20 28 74 65 73 74 73 mdat).... (tests 2d60: 3a 74 65 73 74 71 75 65 75 65 2d 73 65 74 2d 69 :testqueue-set-i 2d70: 74 65 6d 5f 70 61 74 68 21 20 6e 65 77 2d 74 65 tem_path! new-te 2d80: 73 74 2d 72 65 63 6f 72 64 20 6d 79 2d 69 74 65 st-record my-ite 2d90: 6d 2d 70 61 74 68 29 0a 09 09 09 20 28 68 61 73 m-path).... (has 2da0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes 2db0: 74 2d 72 65 63 6f 72 64 73 20 6e 65 77 74 65 73 t-records newtes 2dc0: 74 6e 61 6d 65 20 6e 65 77 2d 74 65 73 74 2d 72 tname new-test-r 2dd0: 65 63 6f 72 64 29 0a 09 09 09 20 28 73 65 74 21 ecord).... (set! 2de0: 20 74 61 6c 20 28 63 6f 6e 73 20 6e 65 77 74 65 tal (cons newte 2df0: 73 74 6e 61 6d 65 20 74 61 6c 29 29 29 29 29 29 stname tal)))))) 2e00: 20 3b 3b 20 73 69 6e 63 65 20 74 68 65 73 65 20 ;; since these 2e10: 61 72 65 20 69 74 65 6d 69 7a 65 64 20 63 72 65 are itemized cre 2e20: 61 74 65 20 6e 65 77 20 74 65 73 74 20 6e 61 6d ate new test nam 2e30: 65 73 20 74 65 73 74 6e 61 6d 65 2f 69 74 65 6d es testname/item 2e40: 70 61 74 68 0a 09 20 20 20 20 20 20 20 69 74 65 path.. ite 2e50: 6d 73 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 ms).. (if ( 2e60: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal)) 2e70: 0a 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 ... (begin... 2e80: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i 2e90: 6e 66 6f 20 34 20 22 45 6e 64 20 6f 66 20 69 74 nfo 4 "End of it 2ea0: 65 6d 73 20 6c 69 73 74 2c 20 6c 6f 6f 70 69 6e ems list, loopin 2eb0: 67 20 77 69 74 68 20 6e 65 78 74 20 61 66 74 65 g with next afte 2ec0: 72 20 73 68 6f 72 74 20 64 65 6c 61 79 22 29 0a r short delay"). 2ed0: 09 09 20 20 20 20 3b 3b 20 28 74 68 72 65 61 64 .. ;; (thread 2ee0: 2d 73 6c 65 65 70 21 20 28 2b 20 30 2e 30 31 20 -sleep! (+ 0.01 2ef0: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 *global-delta*)) 2f00: 0a 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 72 75 ... (loop (ru 2f10: 6e 73 3a 71 75 65 75 65 2d 6e 65 78 74 2d 68 65 ns:queue-next-he 2f20: 64 20 74 61 6c 20 72 65 67 20 72 65 67 6c 65 6e d tal reg reglen 2f30: 20 72 65 67 66 75 6c 6c 29 0a 09 09 09 20 20 28 regfull).... ( 2f40: 72 75 6e 73 3a 71 75 65 75 65 2d 6e 65 78 74 2d runs:queue-next- 2f50: 74 61 6c 20 74 61 6c 20 72 65 67 20 72 65 67 6c tal tal reg regl 2f60: 65 6e 20 72 65 67 66 75 6c 6c 29 0a 09 09 09 20 en regfull).... 2f70: 20 28 72 75 6e 73 3a 71 75 65 75 65 2d 6e 65 78 (runs:queue-nex 2f80: 74 2d 72 65 67 20 74 61 6c 20 72 65 67 20 72 65 t-reg tal reg re 2f90: 67 6c 65 6e 20 72 65 67 66 75 6c 6c 29 0a 09 09 glen regfull)... 2fa0: 09 20 20 72 65 72 75 6e 73 29 29 29 29 0a 0a 09 . reruns))))... 2fb0: 20 20 20 20 20 3b 3b 20 69 66 20 69 74 65 6d 73 ;; if items 2fc0: 20 69 73 20 61 20 70 72 6f 63 20 74 68 65 6e 20 is a proc then 2fd0: 6e 65 65 64 20 74 6f 20 72 75 6e 20 69 74 65 6d need to run item 2fe0: 73 3a 67 65 74 2d 69 74 65 6d 73 2d 66 72 6f 6d s:get-items-from 2ff0: 2d 63 6f 6e 66 69 67 2c 20 67 65 74 20 74 68 65 -config, get the 3000: 20 6c 69 73 74 20 61 6e 64 20 6c 6f 6f 70 20 0a list and loop . 3010: 09 20 20 20 20 20 3b 3b 20 20 20 20 2d 20 62 75 . ;; - bu 3020: 74 20 6f 6e 6c 79 20 64 6f 20 74 68 61 74 20 69 t only do that i 3030: 66 20 72 65 73 6f 75 72 63 65 73 20 65 78 69 73 f resources exis 3040: 74 20 74 6f 20 6b 69 63 6b 20 6f 66 66 20 74 68 t to kick off th 3050: 65 20 6a 6f 62 0a 09 20 20 20 20 20 28 28 6f 72 e job.. ((or 3060: 20 28 70 72 6f 63 65 64 75 72 65 3f 20 69 74 65 (procedure? ite 3070: 6d 73 29 28 65 71 3f 20 69 74 65 6d 73 20 27 68 ms)(eq? items 'h 3080: 61 76 65 2d 70 72 6f 63 65 64 75 72 65 29 29 0a ave-procedure)). 3090: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 61 . (let ((ca 30a0: 6e 2d 72 75 6e 2d 6d 6f 72 65 20 20 20 20 28 72 n-run-more (r 30b0: 75 6e 73 3a 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 uns:can-run-more 30c0: 2d 74 65 73 74 73 20 74 65 73 74 2d 72 65 63 6f -tests test-reco 30d0: 72 64 20 6d 61 78 2d 63 6f 6e 63 75 72 72 65 6e rd max-concurren 30e0: 74 2d 6a 6f 62 73 29 29 29 0a 09 09 28 69 66 20 t-jobs)))...(if 30f0: 28 61 6e 64 20 28 6c 69 73 74 3f 20 63 61 6e 2d (and (list? can- 3100: 72 75 6e 2d 6d 6f 72 65 29 0a 09 09 09 20 28 63 run-more).... (c 3110: 61 72 20 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 29 ar can-run-more) 3120: 29 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 )... (let* (( 3130: 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 prereqs-not-met 3140: 28 64 62 3a 67 65 74 2d 70 72 65 72 65 71 73 2d (db:get-prereqs- 3150: 6e 6f 74 2d 6d 65 74 20 72 75 6e 2d 69 64 20 77 not-met run-id w 3160: 61 69 74 6f 6e 73 20 69 74 65 6d 2d 70 61 74 68 aitons item-path 3170: 20 6d 6f 64 65 3a 20 74 65 73 74 6d 6f 64 65 29 mode: testmode) 3180: 29 0a 09 09 09 20 20 20 28 66 61 69 6c 73 20 20 ).... (fails 3190: 20 20 20 20 20 20 20 20 20 28 72 75 6e 73 3a 63 (runs:c 31a0: 61 6c 63 2d 66 61 69 6c 73 20 70 72 65 72 65 71 alc-fails prereq 31b0: 73 2d 6e 6f 74 2d 6d 65 74 29 29 0a 09 09 09 20 s-not-met)).... 31c0: 20 20 28 6e 6f 6e 2d 63 6f 6d 70 6c 65 74 65 64 (non-completed 31d0: 20 20 20 28 72 75 6e 73 3a 63 61 6c 63 2d 6e 6f (runs:calc-no 31e0: 74 2d 63 6f 6d 70 6c 65 74 65 64 20 70 72 65 72 t-completed prer 31f0: 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 29 29 0a 09 eqs-not-met))).. 3200: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr 3210: 69 6e 74 2d 69 6e 66 6f 20 38 20 22 63 61 6e 2d int-info 8 "can- 3220: 72 75 6e 2d 6d 6f 72 65 3a 20 22 20 63 61 6e 2d run-more: " can- 3230: 72 75 6e 2d 6d 6f 72 65 0a 09 09 09 09 09 22 5c run-more......"\ 3240: 6e 20 74 65 73 74 6e 61 6d 65 3a 20 20 20 20 20 n testname: 3250: 20 20 20 22 20 68 65 64 0a 09 09 09 09 09 22 5c " hed......"\ 3260: 6e 20 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 n prereqs-not-me 3270: 74 3a 20 22 20 28 72 75 6e 73 3a 70 72 65 74 74 t: " (runs:prett 3280: 79 2d 73 74 72 69 6e 67 20 70 72 65 72 65 71 73 y-string prereqs 3290: 2d 6e 6f 74 2d 6d 65 74 29 0a 09 09 09 09 09 22 -not-met)......" 32a0: 5c 6e 20 6e 6f 6e 2d 63 6f 6d 70 6c 65 74 65 64 \n non-completed 32b0: 3a 20 20 20 22 20 28 72 75 6e 73 3a 70 72 65 74 : " (runs:pret 32c0: 74 79 2d 73 74 72 69 6e 67 20 6e 6f 6e 2d 63 6f ty-string non-co 32d0: 6d 70 6c 65 74 65 64 29 20 0a 09 09 09 09 09 22 mpleted) ......" 32e0: 5c 6e 20 66 61 69 6c 73 3a 20 20 20 20 20 20 20 \n fails: 32f0: 20 20 20 20 22 20 28 72 75 6e 73 3a 70 72 65 74 " (runs:pret 3300: 74 79 2d 73 74 72 69 6e 67 20 66 61 69 6c 73 29 ty-string fails) 3310: 0a 09 09 09 09 09 22 5c 6e 20 74 65 73 74 6d 6f ......"\n testmo 3320: 64 65 3a 20 20 20 20 20 20 20 20 22 20 74 65 73 de: " tes 3330: 74 6d 6f 64 65 0a 09 09 09 09 09 22 5c 6e 20 6e tmode......"\n n 3340: 75 6d 2d 72 65 74 72 69 65 73 3a 20 20 20 20 20 um-retries: 3350: 22 20 6e 75 6d 2d 72 65 74 72 69 65 73 0a 09 09 " num-retries... 3360: 09 09 09 22 5c 6e 20 28 65 71 3f 20 74 65 73 74 ..."\n (eq? test 3370: 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 29 3a mode 'toplevel): 3380: 20 22 20 28 65 71 3f 20 74 65 73 74 6d 6f 64 65 " (eq? testmode 3390: 20 27 74 6f 70 6c 65 76 65 6c 29 0a 09 09 09 09 'toplevel)..... 33a0: 09 22 5c 6e 20 28 6e 75 6c 6c 3f 20 6e 6f 6e 2d ."\n (null? non- 33b0: 63 6f 6d 70 6c 65 74 65 64 29 3a 20 20 20 20 22 completed): " 33c0: 20 28 6e 75 6c 6c 3f 20 6e 6f 6e 2d 63 6f 6d 70 (null? non-comp 33d0: 6c 65 74 65 64 29 0a 09 09 09 09 09 22 5c 6e 20 leted)......"\n 33e0: 72 65 72 75 6e 73 3a 20 20 20 20 20 20 20 20 20 reruns: 33f0: 20 22 20 72 65 72 75 6e 73 0a 09 09 09 09 09 22 " reruns......" 3400: 5c 6e 20 69 74 65 6d 73 3a 20 20 20 20 20 20 20 \n items: 3410: 20 20 20 20 22 20 69 74 65 6d 73 0a 09 09 09 09 " items..... 3420: 09 22 5c 6e 20 63 61 6e 2d 72 75 6e 2d 6d 6f 72 ."\n can-run-mor 3430: 65 3a 20 20 20 20 22 20 63 61 6e 2d 72 75 6e 2d e: " can-run- 3440: 6d 6f 72 65 29 0a 09 09 20 20 20 20 20 20 3b 3b more)... ;; 3450: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep! 3460: 28 2b 20 30 2e 30 31 20 2a 67 6c 6f 62 61 6c 2d (+ 0.01 *global- 3470: 64 65 6c 74 61 2a 29 29 0a 09 09 20 20 20 20 20 delta*))... 3480: 20 28 63 6f 6e 64 20 3b 3b 20 49 4e 4e 45 52 20 (cond ;; INNER 3490: 43 4f 4e 44 20 23 32 0a 09 09 20 20 20 20 20 20 COND #2... 34a0: 20 28 28 6f 72 20 28 6e 75 6c 6c 3f 20 70 72 65 ((or (null? pre 34b0: 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 20 3b 3b reqs-not-met) ;; 34c0: 20 61 6c 6c 20 70 72 65 72 65 71 73 20 6d 65 74 all prereqs met 34d0: 2c 20 66 69 72 65 20 6f 66 66 20 74 68 65 20 74 , fire off the t 34e0: 65 73 74 0a 09 09 09 20 20 20 20 3b 3b 20 6f 72 est.... ;; or 34f0: 2c 20 69 66 20 69 74 20 69 73 20 61 20 27 74 6f , if it is a 'to 3500: 70 6c 65 76 65 6c 20 74 65 73 74 20 61 6e 64 20 plevel test and 3510: 61 6c 6c 20 70 72 65 72 65 71 73 20 6e 6f 74 20 all prereqs not 3520: 6d 65 74 20 61 72 65 20 43 4f 4d 50 4c 45 54 45 met are COMPLETE 3530: 44 20 74 68 65 6e 20 6c 61 75 6e 63 68 0a 09 09 D then launch... 3540: 09 20 20 20 20 28 61 6e 64 20 28 65 71 3f 20 74 . (and (eq? t 3550: 65 73 74 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 estmode 'topleve 3560: 6c 29 0a 09 09 09 09 20 28 6e 75 6c 6c 3f 20 6e l)..... (null? n 3570: 6f 6e 2d 63 6f 6d 70 6c 65 74 65 64 29 29 29 0a on-completed))). 3580: 09 09 09 28 6c 65 74 20 28 28 74 65 73 74 2d 6e ...(let ((test-n 3590: 61 6d 65 20 28 74 65 73 74 73 3a 74 65 73 74 71 ame (tests:testq 35a0: 75 65 75 65 2d 67 65 74 2d 74 65 73 74 6e 61 6d ueue-get-testnam 35b0: 65 20 74 65 73 74 2d 72 65 63 6f 72 64 29 29 29 e test-record))) 35c0: 0a 09 09 09 20 20 28 73 65 74 65 6e 76 20 22 4d .... (setenv "M 35d0: 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 T_TEST_NAME" tes 35e0: 74 2d 6e 61 6d 65 29 20 3b 3b 20 0a 09 09 09 20 t-name) ;; .... 35f0: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e (setenv "MT_RUN 3600: 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 NAME" runname) 3610: 0a 09 09 09 20 20 28 73 65 74 2d 6d 65 67 61 74 .... (set-megat 3620: 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 6e est-env-vars run 3630: 2d 69 64 29 20 3b 3b 20 74 68 65 73 65 20 6d 61 -id) ;; these ma 3640: 79 20 62 65 20 6e 65 65 64 65 64 20 62 79 20 74 y be needed by t 3650: 68 65 20 6c 61 75 6e 63 68 69 6e 67 20 70 72 6f he launching pro 3660: 63 65 73 73 0a 09 09 09 20 20 28 6c 65 74 20 28 cess.... (let ( 3670: 28 69 74 65 6d 73 2d 6c 69 73 74 20 28 69 74 65 (items-list (ite 3680: 6d 73 3a 67 65 74 2d 69 74 65 6d 73 2d 66 72 6f ms:get-items-fro 3690: 6d 2d 63 6f 6e 66 69 67 20 74 63 6f 6e 66 69 67 m-config tconfig 36a0: 29 29 29 0a 09 09 09 20 20 20 20 28 69 66 20 28 ))).... (if ( 36b0: 6c 69 73 74 3f 20 69 74 65 6d 73 2d 6c 69 73 74 list? items-list 36c0: 29 0a 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 ).....(begin.... 36d0: 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 . (tests:testqu 36e0: 65 75 65 2d 73 65 74 2d 69 74 65 6d 73 21 20 74 eue-set-items! t 36f0: 65 73 74 2d 72 65 63 6f 72 64 20 69 74 65 6d 73 est-record items 3700: 2d 6c 69 73 74 29 0a 09 09 09 09 20 20 3b 3b 20 -list)..... ;; 3710: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 2a (thread-sleep! * 3720: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 global-delta*).. 3730: 09 09 09 20 20 28 6c 6f 6f 70 20 68 65 64 20 74 ... (loop hed t 3740: 61 6c 20 72 65 67 20 72 65 72 75 6e 73 29 29 0a al reg reruns)). 3750: 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 20 ....(begin..... 3760: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0 3770: 22 45 52 52 4f 52 3a 20 54 68 65 20 70 72 6f 63 "ERROR: The proc 3780: 20 66 72 6f 6d 20 72 65 61 64 69 6e 67 20 74 68 from reading th 3790: 65 20 73 65 74 75 70 20 64 69 64 20 6e 6f 74 20 e setup did not 37a0: 79 69 65 6c 64 20 61 20 6c 69 73 74 20 2d 20 70 yield a list - p 37b0: 6c 65 61 73 65 20 72 65 70 6f 72 74 20 74 68 69 lease report thi 37c0: 73 22 29 0a 09 09 09 09 20 20 28 65 78 69 74 20 s")..... (exit 37d0: 31 29 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 1))))))... 37e0: 20 28 28 6e 75 6c 6c 3f 20 66 61 69 6c 73 29 0a ((null? fails). 37f0: 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ...(debug:print- 3800: 69 6e 66 6f 20 34 20 22 66 61 69 6c 73 20 69 73 info 4 "fails is 3810: 20 6e 75 6c 6c 2c 20 6d 6f 76 69 6e 67 20 6f 6e null, moving on 3820: 20 69 6e 20 74 68 65 20 71 75 65 75 65 20 62 75 in the queue bu 3830: 74 20 6b 65 65 70 69 6e 67 20 22 20 68 65 64 20 t keeping " hed 3840: 22 20 66 6f 72 20 6e 6f 77 22 29 0a 09 09 09 3b " for now")....; 3850: 3b 20 6f 6e 6c 79 20 69 6e 63 72 65 6d 65 6e 74 ; only increment 3860: 20 6e 75 6d 2d 72 65 74 72 69 65 73 20 77 68 65 num-retries whe 3870: 6e 20 74 68 65 72 65 20 61 72 65 20 6e 6f 20 74 n there are no t 3880: 65 73 74 73 20 72 75 6e 69 6e 67 0a 09 09 09 28 ests runing....( 3890: 69 66 20 28 65 71 3f 20 30 20 28 6c 69 73 74 2d if (eq? 0 (list- 38a0: 72 65 66 20 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 ref can-run-more 38b0: 20 31 29 29 0a 09 09 09 20 20 20 20 28 62 65 67 1)).... (beg 38c0: 69 6e 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 54 in.... ;; T 38d0: 52 59 20 28 69 66 20 28 3e 20 6e 75 6d 2d 72 65 RY (if (> num-re 38e0: 74 72 69 65 73 20 31 30 30 29 20 3b 3b 20 66 69 tries 100) ;; fi 38f0: 72 73 74 20 31 30 30 20 72 65 74 72 69 65 73 20 rst 100 retries 3900: 61 72 65 20 6c 6f 77 20 74 69 6d 65 20 63 6f 73 are low time cos 3910: 74 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 54 52 t.... ;; TR 3920: 59 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c Y (thread-sl 3930: 65 65 70 21 20 28 2b 20 32 20 2a 67 6c 6f 62 61 eep! (+ 2 *globa 3940: 6c 2d 64 65 6c 74 61 2a 29 29 0a 09 09 09 20 20 l-delta*)).... 3950: 20 20 20 20 3b 3b 20 54 52 59 20 20 20 20 20 28 ;; TRY ( 3960: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 28 2b thread-sleep! (+ 3970: 20 30 2e 30 31 20 2a 67 6c 6f 62 61 6c 2d 64 65 0.01 *global-de 3980: 6c 74 61 2a 29 29 29 0a 09 09 09 20 20 20 20 20 lta*))).... 3990: 20 28 73 65 74 21 20 6e 75 6d 2d 72 65 74 72 69 (set! num-retri 39a0: 65 73 20 28 2b 20 6e 75 6d 2d 72 65 74 72 69 65 es (+ num-retrie 39b0: 73 20 31 29 29 29 29 0a 09 09 09 28 69 66 20 28 s 1))))....(if ( 39c0: 3e 20 6e 75 6d 2d 72 65 74 72 69 65 73 20 20 6d > num-retries m 39d0: 61 78 2d 72 65 74 72 69 65 73 29 0a 09 09 09 20 ax-retries).... 39e0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c (if (not (nul 39f0: 6c 3f 20 74 61 6c 29 29 0a 09 09 09 09 28 6c 6f l? tal)).....(lo 3a00: 6f 70 20 28 72 75 6e 73 3a 71 75 65 75 65 2d 6e op (runs:queue-n 3a10: 65 78 74 2d 68 65 64 20 74 61 6c 20 72 65 67 20 ext-hed tal reg 3a20: 72 65 67 6c 65 6e 20 72 65 67 66 75 6c 6c 29 0a reglen regfull). 3a30: 09 09 09 09 20 20 20 20 20 20 28 72 75 6e 73 3a .... (runs: 3a40: 71 75 65 75 65 2d 6e 65 78 74 2d 74 61 6c 20 74 queue-next-tal t 3a50: 61 6c 20 72 65 67 20 72 65 67 6c 65 6e 20 72 65 al reg reglen re 3a60: 67 66 75 6c 6c 29 0a 09 09 09 09 20 20 20 20 20 gfull)..... 3a70: 20 28 72 75 6e 73 3a 71 75 65 75 65 2d 6e 65 78 (runs:queue-nex 3a80: 74 2d 72 65 67 20 74 61 6c 20 72 65 67 20 72 65 t-reg tal reg re 3a90: 67 6c 65 6e 20 72 65 67 66 75 6c 6c 29 0a 09 09 glen regfull)... 3aa0: 09 09 20 20 20 20 20 20 72 65 72 75 6e 73 29 29 .. reruns)) 3ab0: 0a 09 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 63 .... (loop (c 3ac0: 61 72 20 6e 65 77 74 61 6c 29 28 63 64 72 20 6e ar newtal)(cdr n 3ad0: 65 77 74 61 6c 29 20 72 65 67 20 72 65 72 75 6e ewtal) reg rerun 3ae0: 73 29 29 29 20 3b 3b 20 61 6e 20 69 73 73 75 65 s))) ;; an issue 3af0: 20 77 69 74 68 20 70 72 65 72 65 71 73 20 6e 6f with prereqs no 3b00: 74 20 79 65 74 20 6d 65 74 3f 0a 09 09 20 20 20 t yet met?... 3b10: 20 20 20 20 28 28 61 6e 64 20 28 6e 6f 74 20 28 ((and (not ( 3b20: 6e 75 6c 6c 3f 20 66 61 69 6c 73 29 29 28 65 71 null? fails))(eq 3b30: 3f 20 74 65 73 74 6d 6f 64 65 20 27 6e 6f 72 6d ? testmode 'norm 3b40: 61 6c 29 29 0a 09 09 09 28 64 65 62 75 67 3a 70 al))....(debug:p 3b50: 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 74 65 73 rint-info 1 "tes 3b60: 74 20 22 20 20 68 65 64 20 22 20 28 6d 6f 64 65 t " hed " (mode 3b70: 3d 22 20 74 65 73 74 6d 6f 64 65 20 22 29 20 68 =" testmode ") h 3b80: 61 73 20 66 61 69 6c 65 64 20 70 72 65 72 65 71 as failed prereq 3b90: 75 69 73 69 74 65 28 73 29 3b 20 22 0a 09 09 09 uisite(s); ".... 3ba0: 09 09 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 .. (string-inte 3bb0: 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 rsperse (map (la 3bc0: 6d 62 64 61 20 28 74 29 28 63 6f 6e 63 20 28 64 mbda (t)(conc (d 3bd0: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn 3be0: 61 6d 65 20 74 29 20 22 3a 22 20 28 64 62 3a 74 ame t) ":" (db:t 3bf0: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 29 est-get-state t) 3c00: 22 2f 22 28 64 62 3a 74 65 73 74 2d 67 65 74 2d "/"(db:test-get- 3c10: 73 74 61 74 75 73 20 74 29 29 29 20 66 61 69 6c status t))) fail 3c20: 73 29 20 22 2c 20 22 29 0a 09 09 09 09 09 20 20 s) ", ")...... 3c30: 22 2c 20 72 65 6d 6f 76 69 6e 67 20 69 74 20 66 ", removing it f 3c40: 72 6f 6d 20 74 6f 2d 64 6f 20 6c 69 73 74 22 29 rom to-do list") 3c50: 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 ....(if (not (nu 3c60: 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 09 20 20 20 ll? tal)).... 3c70: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 (begin.... 3c80: 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee 3c90: 70 21 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 p! *global-delta 3ca0: 2a 29 0a 09 09 09 20 20 20 20 20 20 28 6c 6f 6f *).... (loo 3cb0: 70 20 28 72 75 6e 73 3a 71 75 65 75 65 2d 6e 65 p (runs:queue-ne 3cc0: 78 74 2d 68 65 64 20 74 61 6c 20 72 65 67 20 72 xt-hed tal reg r 3cd0: 65 67 6c 65 6e 20 72 65 67 66 75 6c 6c 29 0a 09 eglen regfull).. 3ce0: 09 09 09 20 20 20 20 28 72 75 6e 73 3a 71 75 65 ... (runs:que 3cf0: 75 65 2d 6e 65 78 74 2d 74 61 6c 20 74 61 6c 20 ue-next-tal tal 3d00: 72 65 67 20 72 65 67 6c 65 6e 20 72 65 67 66 75 reg reglen regfu 3d10: 6c 6c 29 0a 09 09 09 09 20 20 20 20 28 72 75 6e ll)..... (run 3d20: 73 3a 71 75 65 75 65 2d 6e 65 78 74 2d 72 65 67 s:queue-next-reg 3d30: 20 74 61 6c 20 72 65 67 20 72 65 67 6c 65 6e 20 tal reg reglen 3d40: 72 65 67 66 75 6c 6c 29 0a 09 09 09 09 20 20 20 regfull)..... 3d50: 20 28 63 6f 6e 73 20 68 65 64 20 72 65 72 75 6e (cons hed rerun 3d60: 73 29 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 s)))))... 3d70: 28 65 6c 73 65 0a 09 09 09 28 64 65 62 75 67 3a (else....(debug: 3d80: 70 72 69 6e 74 20 38 20 22 45 52 52 4f 52 3a 20 print 8 "ERROR: 3d90: 4e 6f 20 68 61 6e 64 6c 65 72 20 66 6f 72 20 74 No handler for t 3da0: 68 69 73 20 63 6f 6e 64 69 74 69 6f 6e 2e 22 29 his condition.") 3db0: 0a 09 09 09 3b 3b 20 54 52 59 20 28 74 68 72 65 ....;; TRY (thre 3dc0: 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 31 20 2a ad-sleep! (+ 1 * 3dd0: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 0a global-delta*)). 3de0: 09 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 6e 65 ...(loop (car ne 3df0: 77 74 61 6c 29 28 63 64 72 20 6e 65 77 74 61 6c wtal)(cdr newtal 3e00: 29 20 72 65 67 20 72 65 72 75 6e 73 29 29 29 29 ) reg reruns)))) 3e10: 20 3b 3b 20 45 4e 44 20 4f 46 20 49 46 20 43 41 ;; END OF IF CA 3e20: 4e 20 52 55 4e 20 4d 4f 52 45 0a 0a 09 09 20 20 N RUN MORE.... 3e30: 20 20 3b 3b 20 69 66 20 63 61 6e 27 74 20 72 75 ;; if can't ru 3e40: 6e 20 6d 6f 72 65 20 6a 75 73 74 20 6c 6f 6f 70 n more just loop 3e50: 20 77 69 74 68 20 6e 65 78 74 20 70 6f 73 73 69 with next possi 3e60: 62 6c 65 20 74 65 73 74 0a 09 09 20 20 20 20 28 ble test... ( 3e70: 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 begin... (d 3e80: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info 3e90: 34 20 22 70 72 6f 63 65 73 73 69 6e 67 20 74 68 4 "processing th 3ea0: 65 20 63 61 73 65 20 77 69 74 68 20 61 20 6c 61 e case with a la 3eb0: 6d 62 64 61 20 66 6f 72 20 69 74 65 6d 73 20 6f mbda for items o 3ec0: 72 20 27 68 61 76 65 2d 70 72 6f 63 65 64 75 72 r 'have-procedur 3ed0: 65 2e 20 4d 6f 76 69 6e 67 20 74 68 72 6f 75 67 e. Moving throug 3ee0: 68 20 74 68 65 20 71 75 65 75 65 20 77 69 74 68 h the queue with 3ef0: 6f 75 74 20 64 72 6f 70 70 69 6e 67 20 22 20 68 out dropping " h 3f00: 65 64 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 ed)... ;; ( 3f10: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 28 2b thread-sleep! (+ 3f20: 20 32 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2 *global-delta 3f30: 2a 29 29 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f *))... (loo 3f40: 70 20 28 63 61 72 20 6e 65 77 74 61 6c 29 28 63 p (car newtal)(c 3f50: 64 72 20 6e 65 77 74 61 6c 29 20 72 65 67 20 72 dr newtal) reg r 3f60: 65 72 75 6e 73 29 29 29 29 29 20 3b 3b 20 45 4e eruns))))) ;; EN 3f70: 44 20 4f 46 20 28 6f 72 20 28 70 72 6f 63 65 64 D OF (or (proced 3f80: 75 72 65 3f 20 69 74 65 6d 73 29 28 65 71 3f 20 ure? items)(eq? 3f90: 69 74 65 6d 73 20 27 68 61 76 65 2d 70 72 6f 63 items 'have-proc 3fa0: 65 64 75 72 65 29 29 0a 09 20 20 20 20 20 0a 09 edure)).. .. 3fb0: 20 20 20 20 20 3b 3b 20 74 68 69 73 20 63 61 73 ;; this cas 3fc0: 65 20 73 68 6f 75 6c 64 20 6e 6f 74 20 68 61 70 e should not hap 3fd0: 70 65 6e 2c 20 61 64 64 65 64 20 74 6f 20 68 65 pen, added to he 3fe0: 6c 70 20 63 61 74 63 68 20 61 6e 79 20 62 75 67 lp catch any bug 3ff0: 73 0a 09 20 20 20 20 20 28 28 61 6e 64 20 28 6c s.. ((and (l 4000: 69 73 74 3f 20 69 74 65 6d 73 29 20 69 74 65 6d ist? items) item 4010: 64 61 74 29 0a 09 20 20 20 20 20 20 28 64 65 62 dat).. (deb 4020: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO 4030: 52 3a 20 53 68 6f 75 6c 64 20 6e 6f 74 20 68 61 R: Should not ha 4040: 76 65 20 61 20 6c 69 73 74 20 6f 66 20 69 74 65 ve a list of ite 4050: 6d 73 20 69 6e 20 61 20 74 65 73 74 20 61 6e 64 ms in a test and 4060: 20 74 68 65 20 69 74 65 6d 73 70 61 74 68 20 73 the itemspath s 4070: 65 74 20 2d 20 70 6c 65 61 73 65 20 72 65 70 6f et - please repo 4080: 72 74 20 74 68 69 73 22 29 0a 09 20 20 20 20 20 rt this").. 4090: 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 20 (exit 1)).. 40a0: 20 28 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 ((not (null? re 40b0: 72 75 6e 73 29 29 0a 09 20 20 20 20 20 20 28 6c runs)).. (l 40c0: 65 74 2a 20 28 28 6e 65 77 6c 73 74 20 28 74 65 et* ((newlst (te 40d0: 73 74 73 3a 66 69 6c 74 65 72 2d 6e 6f 6e 2d 72 sts:filter-non-r 40e0: 75 6e 6e 61 62 6c 65 20 72 75 6e 2d 69 64 20 74 unnable run-id t 40f0: 61 6c 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 al test-records) 4100: 29 20 3b 3b 20 69 2e 65 2e 20 6e 6f 74 20 46 41 ) ;; i.e. not FA 4110: 49 4c 2c 20 57 41 49 56 45 44 2c 20 49 4e 43 4f IL, WAIVED, INCO 4120: 4d 50 4c 45 54 45 2c 20 50 41 53 53 2c 20 4b 49 MPLETE, PASS, KI 4130: 4c 4c 45 44 2c 0a 09 09 20 20 20 20 20 28 6a 75 LLED,... (ju 4140: 6e 6b 65 64 20 28 6c 73 65 74 2d 64 69 66 66 65 nked (lset-diffe 4150: 72 65 6e 63 65 20 65 71 75 61 6c 3f 20 74 61 6c rence equal? tal 4160: 20 6e 65 77 6c 73 74 29 29 29 0a 09 09 28 64 65 newlst)))...(de 4170: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 bug:print-info 4 4180: 20 22 66 75 6c 6c 20 64 72 6f 70 20 74 68 72 6f "full drop thro 4190: 75 67 68 2c 20 69 66 20 72 65 72 75 6e 73 20 69 ugh, if reruns i 41a0: 73 20 6c 65 73 73 20 74 68 61 6e 20 31 30 30 20 s less than 100 41b0: 77 65 20 77 69 6c 6c 20 66 6f 72 63 65 20 72 65 we will force re 41c0: 74 72 79 20 74 68 65 6d 2c 20 72 65 72 75 6e 73 try them, reruns 41d0: 3d 22 20 72 65 72 75 6e 73 20 22 2c 20 74 61 6c =" reruns ", tal 41e0: 3d 22 20 74 61 6c 29 0a 09 09 28 69 66 20 28 3c =" tal)...(if (< 41f0: 20 6e 75 6d 2d 72 65 74 72 69 65 73 20 6d 61 78 num-retries max 4200: 2d 72 65 74 72 69 65 73 29 0a 09 09 20 20 20 20 -retries)... 4210: 28 73 65 74 21 20 6e 65 77 6c 73 74 20 28 61 70 (set! newlst (ap 4220: 70 65 6e 64 20 72 65 72 75 6e 73 20 6e 65 77 6c pend reruns newl 4230: 73 74 29 29 29 0a 09 09 28 73 65 74 21 20 6e 75 st)))...(set! nu 4240: 6d 2d 72 65 74 72 69 65 73 20 28 2b 20 6e 75 6d m-retries (+ num 4250: 2d 72 65 74 72 69 65 73 20 31 29 29 0a 09 09 3b -retries 1))...; 4260: 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ; (thread-sleep! 4270: 20 28 2b 20 31 20 2a 67 6c 6f 62 61 6c 2d 64 65 (+ 1 *global-de 4280: 6c 74 61 2a 29 29 0a 09 09 28 69 66 20 28 6e 6f lta*))...(if (no 4290: 74 20 28 6e 75 6c 6c 3f 20 6e 65 77 6c 73 74 29 t (null? newlst) 42a0: 29 0a 09 09 20 20 20 20 3b 3b 20 73 69 6e 63 65 )... ;; since 42b0: 20 72 65 72 75 6e 73 20 68 61 76 65 20 62 65 65 reruns have bee 42c0: 6e 20 74 61 63 6b 65 64 20 6f 6e 20 74 6f 20 6e n tacked on to n 42d0: 65 77 6c 73 74 20 63 72 65 61 74 65 20 6e 65 77 ewlst create new 42e0: 20 72 65 72 75 6e 73 20 66 72 6f 6d 20 6a 75 6e reruns from jun 42f0: 6b 65 64 0a 09 09 20 20 20 20 28 6c 6f 6f 70 20 ked... (loop 4300: 28 63 61 72 20 6e 65 77 6c 73 74 29 28 63 64 72 (car newlst)(cdr 4310: 20 6e 65 77 6c 73 74 29 20 72 65 67 20 28 64 65 newlst) reg (de 4320: 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 lete-duplicates 4330: 6a 75 6e 6b 65 64 29 29 29 29 29 0a 09 20 20 20 junked))))).. 4340: 20 20 28 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 ((not (null? t 4350: 61 6c 29 29 0a 09 20 20 20 20 20 20 28 64 65 62 al)).. (deb 4360: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 ug:print-info 4 4370: 22 49 27 6d 20 70 72 65 74 74 79 20 73 75 72 65 "I'm pretty sure 4380: 20 49 20 73 68 6f 75 6c 64 6e 27 74 20 67 65 74 I shouldn't get 4390: 20 68 65 72 65 2e 22 29 29 0a 09 20 20 20 20 20 here.")).. 43a0: 28 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 67 ((not (null? reg 43b0: 29 29 20 3b 3b 20 63 6f 75 6c 64 20 77 65 20 67 )) ;; could we g 43c0: 65 74 20 68 65 72 65 20 77 69 74 68 20 6c 65 66 et here with lef 43d0: 74 6f 76 65 72 73 3f 0a 09 20 20 20 20 20 20 28 tovers?.. ( 43e0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info 43f0: 20 30 20 22 48 61 76 65 20 6c 65 66 74 6f 76 65 0 "Have leftove 4400: 72 73 21 22 29 0a 09 20 20 20 20 20 20 28 6c 6f rs!").. (lo 4410: 6f 70 20 28 63 61 72 20 72 65 67 29 28 63 64 72 op (car reg)(cdr 4420: 20 72 65 67 29 20 27 28 29 20 72 65 72 75 6e 73 reg) '() reruns 4430: 29 29 0a 09 20 20 20 20 20 28 65 6c 73 65 0a 09 )).. (else.. 4440: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri 4450: 6e 74 2d 69 6e 66 6f 20 34 20 22 45 78 69 74 69 nt-info 4 "Exiti 4460: 6e 67 20 6c 6f 6f 70 20 77 69 74 68 2e 2e 2e 5c ng loop with...\ 4470: 6e 20 20 68 65 64 3d 22 20 68 65 64 20 22 5c 6e n hed=" hed "\n 4480: 20 20 74 61 6c 3d 22 20 74 61 6c 20 22 5c 6e 20 tal=" tal "\n 4490: 20 72 65 72 75 6e 73 3d 22 20 72 65 72 75 6e 73 reruns=" reruns 44a0: 29 29 0a 09 20 20 20 20 20 29 29 29 29 20 3b 3b )).. )))) ;; 44b0: 20 4c 45 54 2a 20 28 28 74 65 73 74 2d 72 65 63 LET* ((test-rec 44c0: 6f 72 64 0a 0a 20 20 20 20 3b 3b 20 77 65 20 67 ord.. ;; we g 44d0: 65 74 20 68 65 72 65 20 6f 6e 20 22 64 72 6f 70 et here on "drop 44e0: 20 74 68 72 6f 75 67 68 22 20 2d 20 6c 6f 6f 70 through" - loop 44f0: 20 66 6f 72 20 6e 65 78 74 20 74 65 73 74 20 69 for next test i 4500: 6e 20 71 75 65 75 65 0a 20 20 20 20 3b 3b 20 46 n queue. ;; F 4510: 49 58 4d 45 21 21 21 21 20 54 48 49 53 20 53 48 IXME!!!! THIS SH 4520: 4f 55 4c 44 20 4e 4f 54 20 52 45 51 55 49 52 45 OULD NOT REQUIRE 4530: 20 41 4e 20 45 58 49 54 21 21 21 21 21 21 21 0a AN EXIT!!!!!!!. 4540: 20 20 20 20 0a 20 20 20 20 28 64 65 62 75 67 3a . (debug: 4550: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 41 6c print-info 1 "Al 4560: 6c 20 74 65 73 74 73 20 6c 61 75 6e 63 68 65 64 l tests launched 4570: 22 29 0a 20 20 20 20 28 74 68 72 65 61 64 2d 73 "). (thread-s 4580: 6c 65 65 70 21 20 30 2e 35 29 0a 20 20 20 20 3b leep! 0.5). ; 4590: 3b 20 46 49 58 4d 45 21 20 54 68 69 73 20 68 61 ; FIXME! This ha 45a0: 72 73 68 20 65 78 69 74 20 73 68 6f 75 6c 64 20 rsh exit should 45b0: 6e 6f 74 20 62 65 20 6e 65 63 65 73 73 61 72 79 not be necessary 45c0: 2e 2e 2e 2e 0a 20 20 20 20 3b 3b 20 28 69 66 20 ..... ;; (if 45d0: 28 6e 6f 74 20 2a 72 75 6e 72 65 6d 6f 74 65 2a (not *runremote* 45e0: 29 28 65 78 69 74 29 29 20 3b 3b 20 0a 20 20 20 )(exit)) ;; . 45f0: 20 23 66 29 29 20 3b 3b 20 72 65 74 75 72 6e 20 #f)) ;; return 4600: 61 20 23 66 20 61 73 20 61 20 68 69 6e 74 20 74 a #f as a hint t 4610: 68 61 74 20 77 65 20 61 72 65 20 64 6f 6e 65 0a hat we are done. 4620: 3b 3b 20 48 65 72 65 20 77 65 20 6e 65 65 64 20 ;; Here we need 4630: 74 6f 20 63 68 65 63 6b 20 74 68 61 74 20 61 6c to check that al 4640: 6c 20 74 68 65 20 74 65 73 74 73 20 72 65 6d 61 l the tests rema 4650: 69 6e 69 6e 67 20 74 6f 20 62 65 20 72 75 6e 20 ining to be run 4660: 61 72 65 20 65 6c 69 67 69 62 6c 65 20 74 6f 20 are eligible to 4670: 72 75 6e 0a 3b 3b 20 61 6e 64 20 61 72 65 20 6e run.;; and are n 4680: 6f 74 20 62 6c 6f 63 6b 65 64 20 62 79 20 66 61 ot blocked by fa 4690: 69 6c 65 64 0a 0a iled..