Overview
| Comment: | Converted tests:filter-non-runnable to zmq remote |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | monitor-cleanup |
| Files: | files | file ages | folders |
| SHA1: |
2e36186dcb328a71ef87cfdaffa976e5 |
| User & Date: | mrwellan on 2012-10-30 11:31:57 |
| Other Links: | branch diff | manifest | tags |
Context
|
2012-10-30
| ||
| 12:20 | Corrected couple calls to cdb: routines check-in: ee1cd53670 user: mrwellan tags: monitor-cleanup | |
| 11:31 | Converted tests:filter-non-runnable to zmq remote check-in: 2e36186dcb user: mrwellan tags: monitor-cleanup | |
| 11:23 | Converted sqlite3 loop to remote call check-in: 20c9b7256c user: mrwellan tags: monitor-cleanup | |
Changes
Modified tests.scm from [6ba7b39b04] to [b8b9453ab3].
| ︙ | ︙ | |||
356 357 358 359 360 361 362 363 364 365 366 367 368 369 |
(print "<table cellspacing=\"0\" border=\"1\">"
"<tr><td>Item</td><td>State</td><td>Status</td><td>Comment</td>"
outtxt "</table></body></html>")
(release-dot-lock outputfilename)))
(close-output-port oup)
(change-directory orig-dir)
(tests:test-set-toplog! db run-id test-name outputfilename)
)))))
(define (get-all-legal-tests)
(let* ((tests (glob (conc *toppath* "/tests/*")))
(res '()))
(debug:print-info 4 "Looking at tests " (string-intersperse tests ","))
| > | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 |
(print "<table cellspacing=\"0\" border=\"1\">"
"<tr><td>Item</td><td>State</td><td>Status</td><td>Comment</td>"
outtxt "</table></body></html>")
(release-dot-lock outputfilename)))
(close-output-port oup)
(change-directory orig-dir)
;; NB// tests:test-set-toplog! is remote internal...
(tests:test-set-toplog! db run-id test-name outputfilename)
)))))
(define (get-all-legal-tests)
(let* ((tests (glob (conc *toppath* "/tests/*")))
(res '()))
(debug:print-info 4 "Looking at tests " (string-intersperse tests ","))
|
| ︙ | ︙ | |||
423 424 425 426 427 428 429 | #t ;; this is the correct order, b is waiting on a and b is before a (if (> a-priority b-priority) #t ;; if a is a higher priority than b then we are good to go #f)))))))) ;; for each test: ;; | | | | | | | | | 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 |
#t ;; this is the correct order, b is waiting on a and b is before a
(if (> a-priority b-priority)
#t ;; if a is a higher priority than b then we are good to go
#f))))))))
;; for each test:
;;
(define (tests:filter-non-runnable run-id testkeynames testrecordshash)
(let ((runnables '()))
(for-each
(lambda (testkeyname)
(let* ((test-record (hash-table-ref testrecordshash testkeyname))
(test-name (tests:testqueue-get-testname test-record))
(itemdat (tests:testqueue-get-itemdat test-record))
(item-path (tests:testqueue-get-item_path test-record))
(waitons (tests:testqueue-get-waitons test-record))
(keep-test #t)
(test-id (cdb:remote-run db:get-test-id #f run-id test-name item-path))
(tdat (cdb:remote-run db:get-test-info-by-id #f test-id)))
(if tdat
(begin
;; Look at the test state and status
(if (or (member (db:test-get-status tdat)
'("PASS" "WARN" "WAIVED" "CHECK"))
(member (db:test-get-state tdat)
'("INCOMPLETE" "KILLED")))
(set! keep-test #f))
;; examine waitons for any fails. If it is FAIL or INCOMPLETE then eliminate this test
;; from the runnable list
(if keep-test
(for-each (lambda (waiton)
;; for now we are waiting only on the parent test
(let* ((parent-test-id (cdb:remote-run db:get-test-id #f run-id waiton ""))
(wtdat (cdb:remote-run db:get-test-info-by-id #f test-id)))
(if (or (member (db:test-get-status wtdat)
'("FAIL" "KILLED"))
(member (db:test-get-state wtdat)
'("INCOMPETE")))
(set! keep-test #f)))) ;; no point in running this one again
waitons))))
(if keep-test (set! runnables (cons testkeyname runnables)))))
testkeynames)
runnables))
;;======================================================================
;; test steps
;;======================================================================
;; teststep-set-status! used to be here
(define (test-get-kill-request test-id) ;; run-id test-name itemdat)
(let* (;; (item-path (item-list->path itemdat))
(testdat (cdb:remote-run db:get-test-info-by-id test-id))) ;; run-id test-name item-path)))
(equal? (test:get-state testdat) "KILLREQ")))
(define (test:tdb-get-rundat-count tdb)
(if tdb
(let ((res 0))
(sqlite3:for-each-row
(lambda (count)
|
| ︙ | ︙ |