@@ -27,22 +27,10 @@ (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") -(define (tests:register-test db run-id test-name item-path) - (let ((item-paths (if (equal? item-path "") - (list item-path) - (list item-path "")))) - (for-each - (lambda (pth) - (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');" - run-id - test-name - pth)) - item-paths ))) - ;; get the previous record for when this test was run where all keys match but runname ;; returns #f if no such test found, returns a single test record if found (define (test:get-previous-test-run-record db run-id test-name item-path) (let* ((keys (db:get-keys db)) (selstr (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ",")) @@ -104,11 +92,11 @@ (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals ", previous run ids found: " prev-run-ids) (if (null? prev-run-ids) '() ;; no previous runs? return null (let loop ((hed (car prev-run-ids)) (tal (cdr prev-run-ids))) - (let ((results (rdb:get-tests-for-run db hed test-name item-path '() '()))) + (let ((results (db:get-tests-for-run db hed test-name item-path '() '()))) (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path " results: " (intersperse results "\n")) ;; Keep only the youngest of any test/item combination (for-each (lambda (testdat) @@ -122,22 +110,24 @@ results) (if (null? tal) (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests (loop (car tal)(cdr tal)))))))))) -;; -(define (test-set-status! db test-id state status comment dat) - (let* ((real-status status) +;; Do not rpc this one, do the underlying calls!!! +(define (tests:test-set-status! test-id state status comment dat) + (debug:print 4 "INFO: tests:test-set-status! test-id=" test-id ", state=" state ", status=" status ", dat=" dat) + (let* ((db #f) + (real-status status) (otherdat (if dat dat (make-hash-table))) - (testdat (db:get-test-data-by-id db test-id)) + (testdat (open-run-close db:get-test-info-by-id db test-id)) (run-id (db:test-get-run_id testdat)) (test-name (db:test-get-testname testdat)) (item-path (db:test-get-item-path testdat)) ;; before proceeding we must find out if the previous test (where all keys matched except runname) ;; was WAIVED if this test is FAIL (waived (if (equal? status "FAIL") - (let ((prev-test (test:get-previous-test-run-record db run-id test-name item-path))) + (let ((prev-test (open-run-close test:get-previous-test-run-record db run-id test-name item-path))) (if prev-test ;; true if we found a previous test in this run series (let ((prev-status (db:test-get-status prev-test)) (prev-state (db:test-get-state prev-test)) (prev-comment (db:test-get-comment prev-test))) (debug:print 4 "prev-status " prev-status ", prev-state " prev-state ", prev-comment " prev-comment) @@ -150,16 +140,16 @@ (if waived (set! real-status "WAIVED")) (debug:print 4 "real-status " real-status ", waived " waived ", status " status) ;; update the primary record IF state AND status are defined (if (and state status) - (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-path real-status state)) - + (rdb:test-set-status-state test-id real-status state #f)) + ;; if status is "AUTO" then call rollup (note, this one modifies data in test ;; run area, do not rpc it (yet) (if (and test-id state status (equal? status "AUTO")) - (db:test-data-rollup db test-id status)) + (db:test-data-rollup #f test-id status)) ;; add metadata (need to do this way to avoid SQL injection issues) ;; :first_err ;; (let ((val (hash-table-ref/default otherdat ":first_err" #f))) @@ -189,24 +179,24 @@ expected "," tol "," units "," dcomment ",," ;; extra comma for status type ))) - (rdb:csv->test-data db test-id + (open-run-close db:csv->test-data db test-id dat)))) ;; need to update the top test record if PASS or FAIL and this is a subtest - (rdb:roll-up-pass-fail-counts db run-id test-name item-path status) + (open-run-close db:roll-up-pass-fail-counts db run-id test-name item-path status) (if (or (and (string? comment) (string-match (regexp "\\S+") comment)) waived) (let ((cmt (if waived waived comment))) - (rdb:test-set-comment db test-id cmt))) + (open-run-close db:test-set-comment db test-id cmt))) )) -(define (test-set-toplog! db run-id test-name logf) +(define (tests:test-set-toplog! db run-id test-name logf) (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';" logf run-id test-name)) (define (tests:summarize-items db run-id test-name force) ;; if not force then only update the record if one of these is true: @@ -213,10 +203,11 @@ ;; 1. logf is "log/final.log ;; 2. logf is same as outputfilename (let ((outputfilename (conc "megatest-rollup-" test-name ".html")) (orig-dir (current-directory)) (logf #f)) + ;; This query finds the path and changes the directory to it for the test (sqlite3:for-each-row (lambda (path final_logf) (set! logf final_logf) (if (directory? path) (begin @@ -287,11 +278,11 @@ "