1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
|
;;
;; (define (db:launch-delay-left dbstruct run-id launch-delay)
;; select end_time-now from
;; (select testname,item_path,event_time+run_duration as
;; end_time,strftime('%s','now') as now from tests where state in
;; ('RUNNING','REMOTEHOSTSTART','LAUNCED'));
(define (db:find-and-mark-incomplete dbstruct run-id ovr-deadtime)
(let* ((incompleted '())
(oldlaunched '())
(toplevels '())
(deadtime-str (configf:lookup *configdat* "setup" "deadtime")) ;; FIXME suspect test run time & deadtime are not well matched; resulting in COMPLETED/DEAD status of an a-ok running test
(deadtime (if (and deadtime-str
|
|
|
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
|
;;
;; (define (db:launch-delay-left dbstruct run-id launch-delay)
;; select end_time-now from
;; (select testname,item_path,event_time+run_duration as
;; end_time,strftime('%s','now') as now from tests where state in
;; ('RUNNING','REMOTEHOSTSTART','LAUNCHED'));
(define (db:find-and-mark-incomplete dbstruct run-id ovr-deadtime)
(let* ((incompleted '())
(oldlaunched '())
(toplevels '())
(deadtime-str (configf:lookup *configdat* "setup" "deadtime")) ;; FIXME suspect test run time & deadtime are not well matched; resulting in COMPLETED/DEAD status of an a-ok running test
(deadtime (if (and deadtime-str
|
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
|
(define (db:get-run-times dbstruct run-patt target-patt)
(let ((res `())
(qry (conc "select runname, (max(end_time)-min(event_time))/60 as runtime, target from (select runname, run_id,tests.event_time,tests.event_time+run_duration AS end_time, " (string-join (db:get-keys dbstruct) " || '/' || ") " as target from tests inner join runs on tests.run_id = runs.id where runs.runname like ? and target like ?) group by run_id ;")))
(print qry)
(db:with-db
dbstruct
#f ;; this is for the main runs db
#f ;; does not modify db
(lambda (db)
(sqlite3:for-each-row
(lambda (runname runtime target )
|
|
|
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
|
(define (db:get-run-times dbstruct run-patt target-patt)
(let ((res `())
(qry (conc "select runname, (max(end_time)-min(event_time))/60 as runtime, target from (select runname, run_id,tests.event_time,tests.event_time+run_duration AS end_time, " (string-join (db:get-keys dbstruct) " || '/' || ") " as target from tests inner join runs on tests.run_id = runs.id where runs.runname like ? and target like ?) group by run_id ;")))
;(print qry)
(db:with-db
dbstruct
#f ;; this is for the main runs db
#f ;; does not modify db
(lambda (db)
(sqlite3:for-each-row
(lambda (runname runtime target )
|
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
|
(sqlite3:for-each-row
(lambda (test-name item-path test-time target )
(set! res (cons (vector test-name item-path test-time) res)))
db
qry
run-name target)
res))))
;;======================================================================
;; S T E P S
;;======================================================================
(define (db:teststep-set-status! dbstruct run-id test-id teststep-name state-in status-in comment logfile)
(db:with-db
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
|
(sqlite3:for-each-row
(lambda (test-name item-path test-time target )
(set! res (cons (vector test-name item-path test-time) res)))
db
qry
run-name target)
res))))
(define (db:get-test-times dbstruct run-name target)
(let ((res `())
(qry (conc "select testname, item_path, run_duration, " (string-join (db:get-keys dbstruct) " || '/' || ") " as target from tests inner join runs on tests.run_id = runs.id where runs.runname = ? and target = ? ;")))
(db:with-db
dbstruct
#f ;; this is for the main runs db
#f ;; does not modify db
(lambda (db)
(sqlite3:for-each-row
(lambda (test-name item-path test-time target )
(set! res (cons (vector test-name item-path test-time) res)))
db
qry
run-name target)
res))))
;;======================================================================
;; S T E P S
;;======================================================================
(define (db:teststep-set-status! dbstruct run-id test-id teststep-name state-in status-in comment logfile)
(db:with-db
|
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
|
;; (if (equal? (db:test-get-item-path testdat) "")
;; (db:test-get-testname testdat)
;; (conc (db:test-get-testname testdat)
;; "/"
;; (db:test-get-item-path testdat))))
running-tests) ;; calling functions want the entire data
'())
(if (or (not waitons)
(null? waitons))
'()
(let* ((unmet-pre-reqs '())
(result '()))
(for-each
(lambda (waitontest-name)
;; by getting the tests with matching name we are looking only at the matching test
;; and related sub items
;; next should be using mt:get-tests-for-run?
(let ((tests (db:get-tests-for-run-state-status dbstruct run-id waitontest-name))
(item-waiton-met #f))
(for-each
(lambda (test) ;; BB- this is the upstream test
;; (if (equal? waitontest-name (db:test-get-testname test)) ;; by defintion this had better be true ...
(let* ((state (db:test-get-state test))
(status (db:test-get-status test))
(item-path (db:test-get-item-path test)) ;; BB- this is the upstream itempath
(is-completed (equal? state "COMPLETED"))
(is-running (equal? state "RUNNING"))
(is-killed (equal? state "KILLED"))
(is-ok (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
;; testname-b path-a path-b
(same-itempath (db:compare-itempaths ref-test-name item-path ref-item-path itemmaps))) ;; (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
((and (not (null? (lset-intersection eq? mode '(itemmatch itemwait)))) ;; how is that different from (member mode '(itemmatch itemwait)) ?????
;; (not (equal? item-path "")) ;; this applies to both top level (to allow launching of next batch) and items
same-itempath)
(if (and is-completed is-ok)
(set! item-waiton-met #t))
(if (and (equal? item-path "") ;; if upstream rollup test is completed, parent-waiton-met is set
(or is-completed is-running));; this is the parent, set it to run if completed or running ;; BB1
((and is-completed
(or is-ok
(member 'toplevel mode)) ;; toplevel does not block on FAIL
(and is-ok (member 'itemmatch mode))) ;; itemmatch blocks on not ok
(set! item-waiton-met #t)))))
tests)
(if (not (or parent-waiton-met item-waiton-met))
(set! result (append (if (null? tests) (list waitontest-name) tests) result))) ;; appends the string if the full record is not available
(if (not ever-seen)
(set! result (append (if (null? tests)(list waitontest-name) tests) result)))))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
|
>
>
>
|
|
>
>
|
|
<
|
|
|
>
>
|
|
|
|
|
>
|
>
>
>
>
|
|
|
>
|
|
|
>
<
<
|
>
|
|
>
|
|
|
|
|
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
|
;; (if (equal? (db:test-get-item-path testdat) "")
;; (db:test-get-testname testdat)
;; (conc (db:test-get-testname testdat)
;; "/"
;; (db:test-get-item-path testdat))))
running-tests) ;; calling functions want the entire data
'())
;; collection of: for each waiton -
;; if this ref-test-name is an item in an itemized test and mode is itemwait/itemmatch:
;; if waiton is not itemized - if waiton is not both completed and in ok status, add as unmet prerequisite
;; if waiton is itemized:
;; and waiton's items are not expanded, add as unmet prerequisite
;; else if matching waiton item is not both completed and in an ok status, add as unmet prerequisite
;; else
;; if waiton toplevel is not in both completed and ok status, add as unmet prerequisite
(if (or (not waitons)
(null? waitons))
'()
(let* ((ref-test-itemized-mode (not (null? (lset-intersection eq? mode '(itemmatch itemwait)))))
(ref-test-toplevel-mode (not (null? (lset-intersection eq? mode '(toplevel)))))
(ref-test-is-toplevel (equal? ref-item-path ""))
(ref-test-is-item (not ref-test-is-toplevel))
(unmet-pre-reqs '())
(result '())
(unmet-prereq-items '())
)
(for-each ; waitons
(lambda (waitontest-name)
;; by getting the tests with matching name we are looking only at the matching test
;; and related sub items
;; next should be using mt:get-tests-for-run?
(let (;(waiton-is-itemized ...)
;(waiton-items-are-expanded ...)
(waiton-tests (db:get-tests-for-run-state-status dbstruct run-id waitontest-name))
(ever-seen #f)
(parent-waiton-met #f)
(item-waiton-met #f)
)
(for-each ; test expanded from waiton
(lambda (waiton-test)
(let* ((waiton-state (db:test-get-state waiton-test))
(waiton-status (db:test-get-status waiton-test))
(waiton-item-path (db:test-get-item-path waiton-test)) ;; BB- this is the upstream itempath
(waiton-is-toplevel (equal? waiton-item-path ""))
(waiton-is-item (not waiton-is-toplevel))
(waiton-is-completed (member waiton-state *common:ended-states*))
(waiton-is-running (member waiton-state *common:running-states*))
(waiton-is-killed (member waiton-state *common:badly-ended-states*))
(waiton-is-ok (member waiton-status *common:well-ended-states*))
;; testname-b path-a path-b
(same-itempath (db:compare-itempaths ref-test-name waiton-item-path ref-item-path itemmaps))) ;; (equal? ref-item-path waiton-item-path)))
(set! ever-seen #t)
;;(BB> "***consider waiton "waiton-test"/"waiton-item-path"***")
(cond
;; case 0 - toplevel of an itemized test, at least one item in prereq has completed
((and waiton-is-item ref-test-is-toplevel ref-test-itemized-mode waiton-is-completed)
(set! parent-waiton-met #t))
;; case 1, non-item (parent test) is
((and waiton-is-toplevel ;; this is the parent test of the waiton being examined
waiton-is-completed
;;(BB> "cond1")
(or waiton-is-ok ref-test-toplevel-mode)) ;; itemmatch itemwait))))))
(set! parent-waiton-met #t))
;; Special case for toplevel and KILLED
((and waiton-is-toplevel ;; this is the parent test
waiton-is-killed
(member 'toplevel mode))
;;(BB> "cond2")
(set! parent-waiton-met #t))
;; For itemwait mode IFF the previous matching item is good the set parent-waiton-met
((and ref-test-itemized-mode ref-test-is-item same-itempath)
;;(BB> "cond3")
(if (and waiton-is-completed (or waiton-is-ok ref-test-toplevel-mode))
(set! item-waiton-met #t)
(set! unmet-prereq-items (cons waiton-test unmet-prereq-items)))
(if (and waiton-is-toplevel ;; if upstream rollup test is completed, parent-waiton-met is set
(or waiton-is-completed waiton-is-running))
(set! parent-waiton-met #t)))
;; normal checking of parent items, any parent or parent item not ok blocks running
((and waiton-is-completed
(or waiton-is-ok
(member 'toplevel mode)) ;; toplevel does not block on FAIL
(and waiton-is-ok (member 'itemmatch mode) ;; itemmatch blocks on not ok
))
;;(BB> "cond4")
(set! item-waiton-met #t))
((and waiton-is-completed waiton-is-ok same-itempath)
;;(BB> "cond5")
(set! item-waiton-met #t))
(else
#t
;;(BB> "condelse")
))))
waiton-tests)
;; both requirements, parent and item-waiton must be met to NOT add item to
;; prereq's not met list
;; (BB>
;; "\n* waiton-tests "waiton-tests
;; "\n* parent-waiton-met "parent-waiton-met
;; "\n* item-waiton-met "item-waiton-met
;; "\n* ever-seen "ever-seen
;; "\n* ref-test-itemized-mode "ref-test-itemized-mode
;; "\n* unmet-prereq-items "unmet-prereq-items
;; "\n* result (pre) "result
;; "\n* ever-seen "ever-seen
;; "\n")
(cond
((and ref-test-itemized-mode ref-test-is-item (not (null? unmet-prereq-items)))
(set! result (append unmet-prereq-items result)))
((not (or parent-waiton-met item-waiton-met))
(set! result (append (if (null? waiton-tests) (list waitontest-name) waiton-tests) result))) ;; appends the string if the full record is not available
;; if the test is not found then clearly the waiton is not met...
;; (if (not ever-seen)(set! result (cons waitontest-name result)))))
((not ever-seen)
(set! result (append (if (null? waiton-tests)(list waitontest-name) waiton-tests) result))))))
waitons)
(delete-duplicates result)))))
;;======================================================================
;; Just for sync, procedures to make sync easy
;;======================================================================
|