1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
|
(define (cdb:logout serverdat keyval signature)
(cdb:client-call serverdat 'logout #t *default-numtries* keyval signature))
(define (cdb:num-clients serverdat)
(cdb:client-call serverdat 'numclients #t *default-numtries*))
(define (cdb:test-set-status-state serverdat test-id status state msg)
(if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
(cdb:client-call serverdat 'set-test-start-time #t *default-numtries* test-id))
(if msg
(cdb:client-call serverdat 'state-status-msg #t *default-numtries* state status msg test-id)
(cdb:client-call serverdat 'state-status #t *default-numtries* state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree)
(define (cdb:test-rollup-test_data-pass-fail serverdat test-id)
(cdb:client-call serverdat 'test_data-pf-rollup #t *default-numtries* test-id test-id test-id test-id))
(define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
(cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))
(define (cdb:tests-register-test serverdat run-id test-name item-path)
(cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path))
(define (cdb:flush-queue serverdat)
(cdb:client-call serverdat 'flush #f *default-numtries*))
(define (cdb:kill-server serverdat pid)
(cdb:client-call serverdat 'killserver #t *default-numtries* pid))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
|
(define (cdb:logout serverdat keyval signature)
(cdb:client-call serverdat 'logout #t *default-numtries* keyval signature))
(define (cdb:num-clients serverdat)
(cdb:client-call serverdat 'numclients #t *default-numtries*))
;; I think this would be more efficient if executed on client side FIXME???
(define (cdb:test-set-status-state serverdat test-id status state msg)
(if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
(cdb:client-call serverdat 'set-test-start-time #t *default-numtries* test-id))
(if msg
(cdb:client-call serverdat 'state-status-msg #t *default-numtries* state status msg test-id)
(cdb:client-call serverdat 'state-status #t *default-numtries* state status test-id))) ;; run-id test-name item-path minutes cpuload diskfree tmpfree)
(define (cdb:test-rollup-test_data-pass-fail serverdat test-id)
(cdb:client-call serverdat 'test_data-pf-rollup #t *default-numtries* test-id test-id test-id test-id))
(define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
(cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))
(define (cdb:tests-register-test serverdat run-id test-name item-path)
(cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path))
;; more transactioned calls, these for roll-up-pass-fail stuff
(define (cdb:update-pass-fail-counts serverdat run-id test-name)
(cdb:client-call serverdat 'update-fail-pass-counts #t *default-numtries* run-id test-name run-id test-name run-id test-name))
(define (cdb:top-test-set-running serverdat run-id test-name)
(cdb:client-call serverdat 'top-test-set-running #t *default-numtries* run-id test-name))
(define (cdb:top-test-set-per-pf-counts serverdat run-id test-name)
(cdb:client-call serverdat 'top-test-set-per-pf-counts #t *default-numtries* run-id test-name run-id test-name run-id test-name))
;;=
(define (cdb:flush-queue serverdat)
(cdb:client-call serverdat 'flush #f *default-numtries*))
(define (cdb:kill-server serverdat pid)
(cdb:client-call serverdat 'killserver #t *default-numtries* pid))
|
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
|
'(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;")
'(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;")
'(update-run-duration "UPDATE tests SET run_duration=? WHERE id=?;")
'(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;")
'(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
'(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
))
;; do not run these as part of the transaction
(define db:special-queries '(rollup-tests-pass-fail
db:roll-up-pass-fail-counts
login
immediate
flush
sync
set-verbosity
killserver
))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
|
'(delete-tests-in-state "DELETE FROM tests WHERE state=? AND run_id=?;")
'(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;")
'(update-run-duration "UPDATE tests SET run_duration=? WHERE id=?;")
'(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;")
'(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
'(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
;; stuff for roll-up-pass-fail-counts
'(update-fail-pass-counts "UPDATE tests
SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
WHERE run_id=? AND testname=? AND item_path='';")
'(top-test-set-running "UPDATE tests SET state='RUNNING' WHERE run_id=? AND testname=? AND item_path='';")
'(top-test-set-per-pf-counts "UPDATE tests
SET state=CASE
WHEN (SELECT count(id) FROM tests
WHERE run_id=? AND testname=?
AND item_path != ''
AND state in ('RUNNING','NOT_STARTED')) > 0 THEN 'RUNNING'
ELSE 'COMPLETED' END,
status=CASE
WHEN fail_count > 0 THEN 'FAIL'
WHEN pass_count > 0 AND fail_count=0 THEN 'PASS'
WHEN (SELECT count(id) FROM tests
WHERE run_id=? AND testname=?
AND item_path != ''
AND status = 'SKIP') > 0 THEN 'SKIP'
ELSE 'UNKNOWN' END
WHERE run_id=? AND testname=? AND item_path='';")
))
;; do not run these as part of the transaction
(define db:special-queries '(rollup-tests-pass-fail
;; db:roll-up-pass-fail-counts ;; WHY NOT!?
login
immediate
flush
sync
set-verbosity
killserver
))
|
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
|
(lambda (id itempath state status run_duration logf comment)
(set! res (cons (vector id itempath state status run_duration logf comment) res)))
db
"SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path != '';"
run-id test-name)
res))
;; Rollup the pass/fail counts from itemized tests into fail_count and pass_count
;; NOTE: Is this duplicating (db:test-data-rollup db test-id status) ????
(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
;; (cdb:flush-queue *runremote*)
(if (and (not (equal? item-path ""))
(member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
(begin
(sqlite3:execute
db
"UPDATE tests
SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
WHERE run_id=? AND testname=? AND item_path='';"
run-id test-name run-id test-name run-id test-name)
;; (thread-sleep! 0.1) ;; give other processes a chance here, no, better to be done ASAP?
(if (equal? status "RUNNING") ;; running takes priority over all other states, force the test state to RUNNING
(sqlite3:execute db "UPDATE tests SET state=? WHERE run_id=? AND testname=? AND item_path='';" "RUNNING" run-id test-name)
(sqlite3:execute
db
"UPDATE tests
SET state=CASE
WHEN (SELECT count(id) FROM tests
WHERE run_id=? AND testname=?
AND item_path != ''
AND state in ('RUNNING','NOT_STARTED')) > 0 THEN 'RUNNING'
ELSE 'COMPLETED' END,
status=CASE
WHEN fail_count > 0 THEN 'FAIL'
WHEN pass_count > 0 AND fail_count=0 THEN 'PASS'
WHEN (SELECT count(id) FROM tests
WHERE run_id=? AND testname=?
AND item_path != ''
AND status = 'SKIP') > 0 THEN 'SKIP'
ELSE 'UNKNOWN' END
WHERE run_id=? AND testname=? AND item_path='';"
run-id test-name run-id test-name run-id test-name))
#f)
#f))
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
|
(lambda (id itempath state status run_duration logf comment)
(set! res (cons (vector id itempath state status run_duration logf comment) res)))
db
"SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path != '';"
run-id test-name)
res))
;;======================================================================
;; Tests meta data
;;======================================================================
;; read the record given a testname
(define (db:testmeta-get-record db testname)
(let ((res #f))
|