Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -238,123 +238,123 @@ (count (cdr dat))) (if (> count 0) (debug:print 0 (format #f " ~10a ~5a" tblname count))))) (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b)))))))) -(define (db:sync-to fromdb todb) - ;; strategy - ;; 1. Get all run-ids - ;; 2. For each run-id - ;; a. Sync that run in a transaction - (let ((trecchgd 0) - (rrecchgd 0) - (tmrecchgd 0)) - - ;; First sync test_meta data - (let ((tmgetstmt (sqlite3:prepare todb "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta WHERE id=?;")) - (tmputstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO test_meta (id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup) - VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);")) - (tmdats (db:testmeta-get-all fromdb))) - ;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id) - (for-each - (lambda (tmdat) ;; iterate over tests - (let ((testm-id (vector-ref tmdat 0))) - (sqlite3:with-transaction - todb - (lambda () - (let ((curr-tmdat #f)) - (sqlite3:for-each-row - (lambda (a . b) - (set! curr-tmdat (apply vector a b))) - tmgetstmt testm-id) - (if (not (equal? curr-tmdat tmdat)) ;; something changed - (begin - (debug:print 0 " test-id: " testm-id - "\ncurr-tdat: " curr-tmdat - "\n tdat: " tmdat) - (apply sqlite3:execute tmputstmt (vector->list tmdat)) - (set! tmrecchgd (+ tmrecchgd 1))))))))) - tmdats) - (sqlite3:finalize! tmgetstmt) - (sqlite3:finalize! tmputstmt)) - - ;; First sync tests data - (let ((run-ids (db:get-all-run-ids fromdb)) - (tgetstmt (sqlite3:prepare todb "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;")) - (tputstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO tests (id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment) - VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? );"))) - (for-each - (lambda (run-id) - (let ((tdats (db:get-all-tests-info-by-run-id fromdb run-id))) - ;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id) - (for-each - (lambda (tdat) ;; iterate over tests - (let ((test-id (vector-ref tdat 0))) - (sqlite3:with-transaction - todb - (lambda () - (let ((curr-tdat #f)) - (sqlite3:for-each-row - (lambda (a . b) - (set! curr-tdat (apply vector a b))) - tgetstmt - test-id) - (if (not (equal? curr-tdat tdat)) ;; something changed - (begin - (debug:print 0 " test-id: " test-id - "\ncurr-tdat: " curr-tdat - "\n tdat: " tdat) - (apply sqlite3:execute tputstmt (vector->list tdat)) - (set! trecchgd (+ trecchgd 1))))))))) - tdats))) - run-ids) - (sqlite3:finalize! tgetstmt) - (sqlite3:finalize! tputstmt)) - - ;; Next sync runs table - (let* ((rdats '()) - (keys (db:get-keys fromdb)) - (rstdfields (conc "id," (string-intersperse keys ",") ",runname,state,status,owner,event_time,comment,fail_count,pass_count")) - (rnumfields (length (string-split rstdfields ","))) - (runslots (string-intersperse (make-list rnumfields "?") ",")) - (rgetstmt (sqlite3:prepare todb (conc "SELECT " rstdfields " FROM runs WHERE id=?;"))) - (rputstmt (sqlite3:prepare todb (conc "INSERT OR REPLACE INTO runs (" rstdfields ") VALUES ( " runslots " );")))) - ;; first collect all the source run data - (sqlite3:for-each-row - (lambda (a . b) - (set! rdats (cons (apply vector a b) rdats))) - fromdb - (conc "SELECT " rstdfields " FROM runs;")) - (sqlite3:with-transaction - todb - (lambda () - (for-each - (lambda (rdat) - (let ((run-id (vector-ref rdat 0)) - (curr-rdat #f)) - ;; first get the current value of the equivalent row from the target - ;; read, then insert/overwrite if different - (sqlite3:for-each-row - (lambda (a . b) - (set! curr-rdat (apply vector a b))) - rgetstmt - run-id) - (if (not (equal? curr-rdat rdat)) - (begin - (debug:print 0 " run-id: " run-id - "\ncurr-rdat: " curr-rdat - "\n rdat: " rdat) - (set! rrecchgd (+ rrecchgd 1)) - (apply sqlite3:execute rputstmt (vector->list rdat)))))) - rdats))) - (sqlite3:finalize! rgetstmt) - (sqlite3:finalize! rputstmt)) - - (if (> rrecchgd 0) (debug:print 0 "synced " rrecchgd " changed records in runs table")) - (if (> trecchgd 0) (debug:print 0 "synced " trecchgd " changed records in tests table")) - (if (> tmrecchgd 0) (debug:print 0 "sync'd " tmrecchgd " changed records in test_meta table")) - (+ rrecchgd trecchgd tmrecchgd))) +;; (define (db:sync-to fromdb todb) +;; ;; strategy +;; ;; 1. Get all run-ids +;; ;; 2. For each run-id +;; ;; a. Sync that run in a transaction +;; (let ((trecchgd 0) +;; (rrecchgd 0) +;; (tmrecchgd 0)) +;; +;; ;; First sync test_meta data +;; (let ((tmgetstmt (sqlite3:prepare todb "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta WHERE id=?;")) +;; (tmputstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO test_meta (id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup) +;; VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);")) +;; (tmdats (db:testmeta-get-all fromdb))) +;; ;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id) +;; (for-each +;; (lambda (tmdat) ;; iterate over tests +;; (let ((testm-id (vector-ref tmdat 0))) +;; (sqlite3:with-transaction +;; todb +;; (lambda () +;; (let ((curr-tmdat #f)) +;; (sqlite3:for-each-row +;; (lambda (a . b) +;; (set! curr-tmdat (apply vector a b))) +;; tmgetstmt testm-id) +;; (if (not (equal? curr-tmdat tmdat)) ;; something changed +;; (begin +;; (debug:print 0 " test-id: " testm-id +;; "\ncurr-tdat: " curr-tmdat +;; "\n tdat: " tmdat) +;; (apply sqlite3:execute tmputstmt (vector->list tmdat)) +;; (set! tmrecchgd (+ tmrecchgd 1))))))))) +;; tmdats) +;; (sqlite3:finalize! tmgetstmt) +;; (sqlite3:finalize! tmputstmt)) +;; +;; ;; First sync tests data +;; (let ((run-ids (db:get-all-run-ids fromdb)) +;; (tgetstmt (sqlite3:prepare todb "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;")) +;; (tputstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO tests (id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment) +;; VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? );"))) +;; (for-each +;; (lambda (run-id) +;; (let ((tdats (db:get-all-tests-info-by-run-id fromdb run-id))) +;; ;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id) +;; (for-each +;; (lambda (tdat) ;; iterate over tests +;; (let ((test-id (vector-ref tdat 0))) +;; (sqlite3:with-transaction +;; todb +;; (lambda () +;; (let ((curr-tdat #f)) +;; (sqlite3:for-each-row +;; (lambda (a . b) +;; (set! curr-tdat (apply vector a b))) +;; tgetstmt +;; test-id) +;; (if (not (equal? curr-tdat tdat)) ;; something changed +;; (begin +;; (debug:print 0 " test-id: " test-id +;; "\ncurr-tdat: " curr-tdat +;; "\n tdat: " tdat) +;; (apply sqlite3:execute tputstmt (vector->list tdat)) +;; (set! trecchgd (+ trecchgd 1))))))))) +;; tdats))) +;; run-ids) +;; (sqlite3:finalize! tgetstmt) +;; (sqlite3:finalize! tputstmt)) +;; +;; ;; Next sync runs table +;; (let* ((rdats '()) +;; (keys (db:get-keys fromdb)) +;; (rstdfields (conc "id," (string-intersperse keys ",") ",runname,state,status,owner,event_time,comment,fail_count,pass_count")) +;; (rnumfields (length (string-split rstdfields ","))) +;; (runslots (string-intersperse (make-list rnumfields "?") ",")) +;; (rgetstmt (sqlite3:prepare todb (conc "SELECT " rstdfields " FROM runs WHERE id=?;"))) +;; (rputstmt (sqlite3:prepare todb (conc "INSERT OR REPLACE INTO runs (" rstdfields ") VALUES ( " runslots " );")))) +;; ;; first collect all the source run data +;; (sqlite3:for-each-row +;; (lambda (a . b) +;; (set! rdats (cons (apply vector a b) rdats))) +;; fromdb +;; (conc "SELECT " rstdfields " FROM runs;")) +;; (sqlite3:with-transaction +;; todb +;; (lambda () +;; (for-each +;; (lambda (rdat) +;; (let ((run-id (vector-ref rdat 0)) +;; (curr-rdat #f)) +;; ;; first get the current value of the equivalent row from the target +;; ;; read, then insert/overwrite if different +;; (sqlite3:for-each-row +;; (lambda (a . b) +;; (set! curr-rdat (apply vector a b))) +;; rgetstmt +;; run-id) +;; (if (not (equal? curr-rdat rdat)) +;; (begin +;; (debug:print 0 " run-id: " run-id +;; "\ncurr-rdat: " curr-rdat +;; "\n rdat: " rdat) +;; (set! rrecchgd (+ rrecchgd 1)) +;; (apply sqlite3:execute rputstmt (vector->list rdat)))))) +;; rdats))) +;; (sqlite3:finalize! rgetstmt) +;; (sqlite3:finalize! rputstmt)) +;; +;; (if (> rrecchgd 0) (debug:print 0 "synced " rrecchgd " changed records in runs table")) +;; (if (> trecchgd 0) (debug:print 0 "synced " trecchgd " changed records in tests table")) +;; (if (> tmrecchgd 0) (debug:print 0 "sync'd " tmrecchgd " changed records in test_meta table")) +;; (+ rrecchgd trecchgd tmrecchgd))) (define (db:sync-back) (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)) ;; (db:sync-to *inmemdb* *db*)) ;; keeping it around for debugging purposes only @@ -1456,15 +1456,15 @@ (begin (debug:print-info 4 "db:get-test-info-by-id called with test-id=" test-id) #f) (let ((res #f)) (sqlite3:for-each-row - (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) + (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment pass_count fail_count) ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 - (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment))) + (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment pass_count fail_count))) db - "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;" + "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,pass_count,fail_count FROM tests WHERE id=?;" test-id) res))) ;; Use db:test-get* to access ;; @@ -1474,16 +1474,16 @@ (begin (debug:print-info 4 "db:get-test-info-by-ids called with test-ids=" test-ids) '()) (let ((res '())) (sqlite3:for-each-row - (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) + (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment pass_count fail_count) ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 - (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) + (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment pass_count fail_count) res))) db - (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id in (" + (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,pass_count,fail_count FROM tests WHERE id in (" (string-intersperse (map conc test-ids) ",") ");")) res))) (define (db:get-test-info db run-id testname item-path) (db:get-test-info-by-id db (db:get-test-id db run-id testname item-path))) @@ -1517,21 +1517,21 @@ (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 - "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; + "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; test-id) (reverse res))) (define (db:get-steps-data db 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 - "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; + "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; test-id) (reverse res))) ;;====================================================================== ;; T E S T D A T A @@ -1552,11 +1552,11 @@ db "SELECT (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail') AS fail_count, (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;" test-id test-id) ;; Now rollup the counts to the central megatest.db - (db:general-call db 'pass-fail-counts (list fail-count pass-count test-id)) + (db:general-call db 'pass-fail-counts (list pass-count fail-count test-id)) ;; if the test is not FAIL then set status based on the fail and pass counts. (db:general-call db 'test_data-pf-rollup (list test-id test-id test-id test-id)))) (define (db:csv->test-data db test-id csvdata) (debug:print 4 "test-id " test-id ", csvdata: " csvdata) @@ -1793,11 +1793,11 @@ '(state-status "UPDATE tests SET state=?,status=? WHERE id=?;") '(state-status-msg "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;") ;; Test comment '(set-test-comment "UPDATE tests SET comment=? WHERE id=?;") '(set-test-start-time "UPDATE tests SET event_time=strftime('%s','now') WHERE id=?;") - '(pass-fail-counts "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;") + '(pass-fail-counts "UPDATE tests SET pass_count=?,fail_count=? WHERE id=?;") ;; test_data-pf-rollup is used to set a tests PASS/FAIL based on the pass/fail info from the steps '(test_data-pf-rollup "UPDATE tests SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 THEN 'FAIL' WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND @@ -1836,11 +1836,11 @@ AND status = 'SKIP') > 0 THEN 'SKIP' ELSE 'UNKNOWN' END WHERE run_id=? AND testname=? AND item_path='';") ;; STEPS - '(delete-test-step-records "UPDATE test_steps SET state='DELETED' WHERE id=?;") + '(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE id=?;") '(delete-test-data-records "UPDATE test_data SET status='DELETED' WHERE id=?;") ;; using status since no state field )) ;; do not run these as part of the transaction (define db:special-queries '(rollup-tests-pass-fail Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -12,10 +12,12 @@ (define-inline (db:test-get-rundir vec) (vector-ref vec 10)) (define-inline (db:test-get-item-path vec) (vector-ref vec 11)) (define-inline (db:test-get-run_duration vec) (vector-ref vec 12)) (define-inline (db:test-get-final_logf vec) (vector-ref vec 13)) (define-inline (db:test-get-comment vec) (vector-ref vec 14)) +(define-inline (db:test-get-pass_count vec) (vector-ref vec 15)) +(define-inline (db:test-get-fail_count vec) (vector-ref vec 16)) (define-inline (db:test-get-fullname vec) (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec))) (define-inline (db:test-get-first_err vec) (printable (vector-ref vec 15))) (define-inline (db:test-get-first_warn vec) (printable (vector-ref vec 16))) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -632,11 +632,11 @@ "\n uname: " (db:test-get-uname test) "\n rundir: " (db:test-get-rundir test) ) ;; Each test ;; DO NOT remote run - (let ((steps (tdb:get-steps-for-test (db:test-get-id test)))) + (let ((steps (db:get-steps-for-test db (db:test-get-id test)))) (for-each (lambda (step) (format #t " Step: ~20a State: ~10a Status: ~10a Time ~22a\n" (tdb:step-get-stepname step) Index: tests/unittests/server.scm ================================================================== --- tests/unittests/server.scm +++ tests/unittests/server.scm @@ -81,8 +81,34 @@ (test "get testinfo" "test1" (vector-ref (rmt:get-testinfo-state-status 1) 2)) ;;====================================================================== ;; D B ;;====================================================================== + +(test "pass fail counts" #t (rmt:general-call 'pass-fail-counts 10 9 1)) +(test "get pass fail counts" 19 (let ((dat (rmt:get-test-info-by-id 1))) + (+ (db:test-get-pass_count dat) + (db:test-get-fail_count dat)))) + +(define testregistry (make-hash-table)) +(for-each + (lambda (tname) + (for-each + (lambda (itempath) + (let ((tkey (conc tname "/" itempath)) + (rpass (random 10)) + (rfail (random 10))) + (hash-table-set! testregistry tkey (list tname itempath)) + (rmt:general-call 'register-test 1 tname itempath) + (let* ((tid (rmt:get-test-id 1 tname itempath)) + (tdat (rmt:get-test-info-by-id tid))) + (rmt:general-call 'pass-fail-counts rpass rfail (db:test-get-id tdat)) + (let* ((resdat (rmt:get-test-info-by-id tid))) + (test "set/get pass fail counts" (list rpass rfail) + (list (db:test-get-pass_count resdat) + (db:test-get-fail_count resdat))))))) + (list "" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"))) + (list "test1" "test2" "test3" "test4" "test5")) + (test #f '(#t "exit process started") (rmt:kill-server)) ;; *toppath* *my-client-signature* #f)))