743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
|
(db:get-db dbstruct #f) qry run-id)))
keys)
(reverse res)))
;; get key vals for a given run-id
(define (db:get-key-vals dbstruct run-id)
(let ((mykeyvals (hash-table-ref/default *keyvals* run-id #f)))
(if mykeyvals
mykeyvals
(let* ((keys (db:get-keys dbstruct))
(res '()))
(for-each
(lambda (key)
(let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
(sqlite3:for-each-row
(lambda (key-val)
(set! res (cons key-val res)))
(db:get-db dbstruct #f) qry run-id)))
keys)
(let ((final-res (reverse res)))
(hash-table-set! *keyvals* run-id final-res)
final-res)))))
;; The target is keyval1/keyval2..., cached in *target* as it is used often
(define (db:get-target dbstruct run-id)
(let ((mytarg (hash-table-ref/default *target* run-id #f)))
(if mytarg
mytarg
(let* ((keyvals (db:get-key-vals dbstruct run-id))
|
|
|
|
|
|
|
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
|
(db:get-db dbstruct #f) qry run-id)))
keys)
(reverse res)))
;; get key vals for a given run-id
(define (db:get-key-vals dbstruct run-id)
(let ((mykeyvals (hash-table-ref/default *keyvals* run-id #f)))
(if mykeyvals
mykeyvals
(let* ((keys (db:get-keys dbstruct))
(res '()))
(for-each
(lambda (key)
(let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
(sqlite3:for-each-row
(lambda (key-val)
(set! res (cons key-val res)))
(db:get-db dbstruct #f) qry run-id)))
keys)
(let ((final-res (reverse res)))
(hash-table-set! *keyvals* run-id final-res)
final-res)))))
;; The target is keyval1/keyval2..., cached in *target* as it is used often
(define (db:get-target dbstruct run-id)
(let ((mytarg (hash-table-ref/default *target* run-id #f)))
(if mytarg
mytarg
(let* ((keyvals (db:get-key-vals dbstruct run-id))
|
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
|
(sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id))
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id))))
(mt:process-triggers run-id test-id newstate newstatus)))
;; Never used
;; (define (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
;; (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
;; state status run-id test-name item-path))
;; NEW BEHAVIOR: Count tests running in only one run!
|
|
>
|
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
|
(sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id))
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id))))
(db:process-triggers test-id newstate newstatus)
#t) ;; retrun something to keep the remote calls happy
;; Never used
;; (define (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
;; (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
;; state status run-id test-name item-path))
;; NEW BEHAVIOR: Count tests running in only one run!
|
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
|
(sqlite3:execute (db:get-db dbstruct run-id) 'set-test-start-time test-id))
(if msg
(sqlite3:execute (db:get-db dbstruct run-id) 'state-status-msg state status msg-id test-id)
(sqlite3:execute (db:get-db dbstruct run-id) 'state-status state status test-id)))
(define (db:test-rollup-test_data-pass-fail dbstruct run-id test-id)
(sqlite3:execute (db:get-db dbstruct run-id) 'test_data-pf-rollup test-id test-id test-id test-id))
(define (db:pass-fail-counts dbstruct run-id test-id fail-count pass-count)
(sqlite3:execute (db:get-db dbstruct run-id) 'pass-fail-counts fail-count pass-count test-id))
(define (db:tests-register-test dbstruct run-id test-name item-path)
(sqlite3:execute (db:get-db dbstruct run-id) 'register-test run-id test-name item-path))
|
>
>
|
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
|
(sqlite3:execute (db:get-db dbstruct run-id) 'set-test-start-time test-id))
(if msg
(sqlite3:execute (db:get-db dbstruct run-id) 'state-status-msg state status msg-id test-id)
(sqlite3:execute (db:get-db dbstruct run-id) 'state-status state status test-id)))
(define (db:test-rollup-test_data-pass-fail dbstruct run-id test-id)
(sqlite3:execute (db:get-db dbstruct run-id) 'test_data-pf-rollup test-id test-id test-id test-id))
;; (cdb:client-call serverdat 'set-test-start-time #t *default-numtries* test-id))
(define (db:pass-fail-counts dbstruct run-id test-id fail-count pass-count)
(sqlite3:execute (db:get-db dbstruct run-id) 'pass-fail-counts fail-count pass-count test-id))
(define (db:tests-register-test dbstruct run-id test-name item-path)
(sqlite3:execute (db:get-db dbstruct run-id) 'register-test run-id test-name item-path))
|
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
|
(else (conc "ERROR: bad tol comparator " tol))))))
(debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value
", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
(sqlite3:execute (db:get-db dbstruct run-id) "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
test-id category variable value expected tol units (if comment comment "") status type)))
csvlist)))
;; get a list of test_data records matching categorypatt
(define (db:read-test-data dbstruct run-id test-id categorypatt)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id test_id category variable value expected tol units comment status type)
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
(db:get-db dbstruct run-id)
"SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
(reverse res)))
;; NOTE: Run this local with #f for db !!!
(define (db:load-test-data dbstruct run-id test-id)
(let loop ((lin (read-line)))
(if (not (eof-object? lin))
(begin
(debug:print 4 lin)
(db:csv->test-data dbstruct run-id test-id lin)
|
<
<
|
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
|
(else (conc "ERROR: bad tol comparator " tol))))))
(debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value
", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
(sqlite3:execute (db:get-db dbstruct run-id) "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
test-id category variable value expected tol units (if comment comment "") status type)))
csvlist)))
(define (db:read-test-data dbstruct run-id test-id categorypatt)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id test_id category variable value expected tol units comment status type)
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
(db:get-db dbstruct run-id)
"SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
(reverse res)))
;; NOTE: Run this local with #f for db !!!
(define (db:load-test-data dbstruct run-id test-id)
(let loop ((lin (read-line)))
(if (not (eof-object? lin))
(begin
(debug:print 4 lin)
(db:csv->test-data dbstruct run-id test-id lin)
|
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
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
|
;;======================================================================
;; S T E P S
;;======================================================================
(define (db:step-get-time-as-string vec)
(seconds->time-string (db:step-get-event_time vec)))
;; db-get-test-steps-for-run
(define (db:get-steps-for-test dbstruct run-id test-id)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id test-id stepname state status event-time logfile)
(set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
(db:get-db dbstruct run-id)
"SELECT id,test_id,stepname,state,status,event_time,logfile_id FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-id)
(reverse res)))
;; get a pretty table to summarize steps
;;
(define (db:get-steps-table dbstruct run-id test-id)
(let ((steps (db:get-steps-for-test dbstruct run-id test-id)))
;; organise the steps for better readability
(let ((res (make-hash-table)))
(for-each
(lambda (step)
(debug:print 6 "step=" step)
(let ((record (hash-table-ref/default
res
(db:step-get-stepname step)
;; stepname start end status Duration Logfile
(vector (db:step-get-stepname step) "" "" "" "" ""))))
(debug:print 6 "record(before) = " record
"\nid: " (db:step-get-id step)
"\nstepname: " (db:step-get-stepname step)
"\nstate: " (db:step-get-state step)
"\nstatus: " (db:step-get-status step)
"\ntime: " (db:step-get-event_time step))
(case (string->symbol (db:step-get-state step))
((start)(vector-set! record 1 (db:step-get-event_time step))
(vector-set! record 3 (if (equal? (vector-ref record 3) "")
(db:step-get-status step)))
(if (> (string-length (db:step-get-logfile step))
0)
(vector-set! record 5 (db:step-get-logfile step))))
((end)
(vector-set! record 2 (any->number (db:step-get-event_time step)))
(vector-set! record 3 (db:step-get-status step))
(vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
(endt (any->number (vector-ref record 2))))
(debug:print 4 "record[1]=" (vector-ref record 1)
", startt=" startt ", endt=" endt
", get-status: " (db:step-get-status step))
(if (and (number? startt)(number? endt))
(seconds->hr-min-sec (- endt startt)) "-1")))
(if (> (string-length (db:step-get-logfile step))
0)
(vector-set! record 5 (db:step-get-logfile step))))
(else
(vector-set! record 2 (db:step-get-state step))
(vector-set! record 3 (db:step-get-status step))
(vector-set! record 4 (db:step-get-event_time step))))
(hash-table-set! res (db:step-get-stepname step) record)
(debug:print 6 "record(after) = " record
"\nid: " (db:step-get-id step)
"\nstepname: " (db:step-get-stepname step)
"\nstate: " (db:step-get-state step)
"\nstatus: " (db:step-get-status step)
"\ntime: " (db:step-get-event_time step))))
;; (else (vector-set! record 1 (db:step-get-event_time step)))
(sort steps (lambda (a b)
(cond
((< (db:step-get-event_time a)(db:step-get-event_time b)) #t)
((eq? (db:step-get-event_time a)(db:step-get-event_time b))
(< (db:step-get-id a) (db:step-get-id b)))
(else #f)))))
res)))
;; ;; get a pretty table to summarize steps
;; ;;
;; (define (db:get-steps-table-list dbstruct run-id test-id #!key (work-area #f))
;; (let ((steps (db:get-steps-for-test dbstruct run-id test-id)))
;; ;; organise the steps for better readability
;; (let ((res (make-hash-table)))
;; (for-each
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
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
|
;;======================================================================
;; S T E P S
;;======================================================================
(define (db:step-get-time-as-string vec)
(seconds->time-string (db:step-get-event_time vec)))
(define (db:get-steps-for-test dbstruct run-id test-id)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id test-id stepname state status event-time logfile)
(set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
(db:get-db dbstruct run-id)
"SELECT id,test_id,stepname,state,status,event_time,logfile_id FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-id)
(reverse res)))
(define (db:get-steps-table dbstruct run-id test-id)
(let ((steps (db:get-steps-for-test dbstruct run-id test-id)))
;; ;; get a pretty table to summarize steps
;; ;;
;; (define (db:get-steps-table-list dbstruct run-id test-id #!key (work-area #f))
;; (let ((steps (db:get-steps-for-test dbstruct run-id test-id)))
;; ;; organise the steps for better readability
;; (let ((res (make-hash-table)))
;; (for-each
|