25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
;; (declare (uses filedb))
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
(define (runs:test-get-full-path test)
(let* ((testname (db:test-get-testname test))
(itempath (db:test-get-item-path test)))
(conc testname (if (equal? itempath "") "" (conc "(" itempath ")")))))
|
>
>
|
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
|
;; (declare (uses filedb))
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
(include "debugger.scm")
(define (runs:test-get-full-path test)
(let* ((testname (db:test-get-testname test))
(itempath (db:test-get-item-path test)))
(conc testname (if (equal? itempath "") "" (conc "(" itempath ")")))))
|
484
485
486
487
488
489
490
491
492
493
494
495
496
497
|
"\n fails: " (runs:pretty-string fails)
"\n testmode: " testmode
"\n (member 'toplevel testmode): " (member 'toplevel testmode)
"\n (null? non-completed): " (null? non-completed)
"\n reruns: " reruns
"\n items: " items
"\n can-run-more: " can-run-more)
(cond
;; all prereqs met, fire off the test
;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch
((and (not (member 'toplevel testmode))
(member (hash-table-ref/default test-registry (db:test-make-full-name hed item-path) 'n/a)
|
>
>
>
>
>
>
>
|
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
|
"\n fails: " (runs:pretty-string fails)
"\n testmode: " testmode
"\n (member 'toplevel testmode): " (member 'toplevel testmode)
"\n (null? non-completed): " (null? non-completed)
"\n reruns: " reruns
"\n items: " items
"\n can-run-more: " can-run-more)
;; lets use the debugger eh?
(debugger-start)
(debugger-trace-var "can-run-more" can-run-more)
(debugger-trace-var "hed" hed)
(debugger-trace-var "prereqs-not-met" (runs:pretty-string prereqs-not-met))
(debugger-pauser)
(cond
;; all prereqs met, fire off the test
;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch
((and (not (member 'toplevel testmode))
(member (hash-table-ref/default test-registry (db:test-make-full-name hed item-path) 'n/a)
|
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
|
"\n num-retries: " num-retries
"\n tal: " tal
"\n reruns: " reruns
"\n regfull: " regfull
"\n reglen: " reglen
"\n length reg: " (length reg)
"\n reg: " reg)
;; check for hed in waitons => this would be circular, remove it and issue an
;; error
(if (member test-name waitons)
(begin
(debug:print 0 "ERROR: test " test-name " has listed itself as a waiton, please correct this!")
(set! waiton (filter (lambda (x)(not (equal? x hed))) waitons))))
|
>
>
>
>
>
>
>
>
>
|
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
|
"\n num-retries: " num-retries
"\n tal: " tal
"\n reruns: " reruns
"\n regfull: " regfull
"\n reglen: " reglen
"\n length reg: " (length reg)
"\n reg: " reg)
;; lets use the debugger eh?
(debugger-start start: 5)
(debugger-trace-var "runs:run-tests-queue" "")
(debugger-trace-var "items" items)
(debugger-trace-var "hed" hed)
(debugger-trace-var "waitons" waitons)
(debugger-pauser)
;; check for hed in waitons => this would be circular, remove it and issue an
;; error
(if (member test-name waitons)
(begin
(debug:print 0 "ERROR: test " test-name " has listed itself as a waiton, please correct this!")
(set! waiton (filter (lambda (x)(not (equal? x hed))) waitons))))
|