2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
|
(db:get-db dbstruct run-id)
"SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta;")
res))
;;======================================================================
;; M I S C M A N A G E M E N T I T E M S
;;======================================================================
;; the new prereqs calculation, looks also at itempath if specified
;; all prereqs must be met:
;; if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met
;; if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;; mode 'toplevel means that tests must be COMPLETED only
;; mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;;
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode)
(if (or (not waitons)
(null? waitons))
'()
(let* ((unmet-pre-reqs '())
(result '()))
(for-each
(lambda (waitontest-name)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
|
(db:get-db dbstruct run-id)
"SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta;")
res))
;;======================================================================
;; M I S C M A N A G E M E N T I T E M S
;;======================================================================
;; A routine to map itempaths using a itemmap
(define (db:compare-itempaths patha pathb itemmap)
(debug:print-info 3 "ITEMMAP is " itemmap)
(if itemmap
(let* ((mapparts (string-split itemmap))
(pattern (car mapparts))
(replacement (if (> (length mapparts) 1) (cadr mapparts) "")))
(if replacement
(equal? (string-substitute pattern replacement patha)
(string-substitute pattern replacement pathb))
(equal? (string-substitute pattern "" patha)
(string-substitute pattern "" pathb))))
(equal? patha pathb)))
;; the new prereqs calculation, looks also at itempath if specified
;; all prereqs must be met:
;; if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met
;; if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;; mode 'toplevel means that tests must be COMPLETED only
;; mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;;
;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))
(if (or (not waitons)
(null? waitons))
'()
(let* ((unmet-pre-reqs '())
(result '()))
(for-each
(lambda (waitontest-name)
|
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
|
(let* ((state (db:test-get-state test))
(status (db:test-get-status test))
(item-path (db:test-get-item-path test))
(is-completed (equal? state "COMPLETED"))
(is-running (equal? state "RUNNING"))
(is-killed (equal? state "KILLED"))
(is-ok (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
(same-itempath (equal? ref-item-path item-path)))
(set! ever-seen #t)
(cond
;; case 1, non-item (parent test) is
((and (equal? item-path "") ;; this is the parent test
is-completed
(or is-ok (not (null? (lset-intersection eq? mode '(toplevel itemmatch itemwait))))))
(set! parent-waiton-met #t))
;; Special case for toplevel and KILLED
((and (equal? item-path "") ;; this is the parent test
is-killed
(member 'toplevel mode))
(set! parent-waiton-met #t))
;; For itemwait mode IFF the previous matching item is good the set parent-waiton-met
|
|
|
|
|
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
|
(let* ((state (db:test-get-state test))
(status (db:test-get-status test))
(item-path (db:test-get-item-path test))
(is-completed (equal? state "COMPLETED"))
(is-running (equal? state "RUNNING"))
(is-killed (equal? state "KILLED"))
(is-ok (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
(same-itempath (db:compare-itempaths ref-item-path item-path itemmap))) ;; (equal? ref-item-path item-path)))
(set! ever-seen #t)
(cond
;; case 1, non-item (parent test) is
((and (equal? item-path "") ;; this is the parent test of the waiton being examined
is-completed
(or is-ok (not (null? (lset-intersection eq? mode '(toplevel)))))) ;; itemmatch itemwait))))))
(set! parent-waiton-met #t))
;; Special case for toplevel and KILLED
((and (equal? item-path "") ;; this is the parent test
is-killed
(member 'toplevel mode))
(set! parent-waiton-met #t))
;; For itemwait mode IFF the previous matching item is good the set parent-waiton-met
|