Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -979,15 +979,18 @@ "SELECT rundir FROM tests WHERE id=?;" test-id) (hash-table-set! *test-paths* test-id res) res)))) -(define (db:test-set-log! db test-id logf) - (if (string? logf) - (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE id=?;" - logf test-id) - (debug:print 0 "ERROR: db:test-set-log! called with non-string log file name " logf))) +(define (cdb:test-set-log! zmqsocket test-id logf) + (if (string? logf)(cdb:client-call zmqsocket 'test-set-log #t test-id logf))) + +;; (define (db:test-set-log! db test-id logf) +;; (if (string? logf) +;; (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE id=?;" +;; logf test-id) +;; (debug:print 0 "ERROR: db:test-set-log! called with non-string log file name " logf))) ;;====================================================================== ;; Misc. test related queries ;;====================================================================== @@ -1193,11 +1196,12 @@ (rollup-tests-pass-fail "UPDATE tests SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status='FAIL'), pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND (status='PASS' OR status='WARN' OR status='WAIVED')) - WHERE run_id=? AND testname=? AND item_path='';"))) + WHERE run_id=? AND testname=? AND item_path='';") + (test-set-log "UPDATE tests SET final_logf=? WHERE id=?;"))) (define db:special-queries '(rollup-tests-pass-fail)) (define db:run-local-queries '(rollup-tests-pass-fail)) ;; The queue is a list of vectors where the zeroth slot indicates the type of query to @@ -1228,11 +1232,11 @@ (stmts data)) (if special-qry ;; handle a query that cannot be part of the grouped queries (let* ((stmt-key (vector-ref special-qry 0)) (qry (hash-table-ref queries stmt-key)) - (params (vector-ref speical-qry 2))) + (params (vector-ref special-qry 2))) (apply sqlite3:execute db qry params) (if (not (null? stmts)) (outerloop #f stmts))) ;; handle normal queries (sqlite3:with-transaction @@ -1726,54 +1730,5 @@ results) ;; brutal clean up (system "rm -rf tempdir"))) ;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%") - - -;;====================================================================== -;; REMOTE DB ACCESS VIA RPC -;;====================================================================== - -;; (define (rdb:test-set-status-state test-id status state msg) -;; (if *runremote* -;; (let ((host (vector-ref *runremote* 0)) -;; (port (vector-ref *runremote* 1))) -;; (handle-exceptions -;; exn -;; (begin -;; (debug:print 0 "EXCEPTION: rpc call failed?") -;; (debug:print 0 " " ((condition-property-accessor 'exn 'message) exn)) -;; (print-call-chain) -;; (cdb:test-set-status-state test-id status state msg)) -;; ((rpc:procedure 'cdb:test-set-status-state host port) test-id status state msg))) -;; (cdb:test-set-status-state test-id status state msg))) -;; -;; (define (rdb:test-rollup-test_data-pass-fail test-id) -;; (if *runremote* -;; (let ((host (vector-ref *runremote* 0)) -;; (port (vector-ref *runremote* 1))) -;; ((rpc:procedure 'cdb:test-rollup-test_data-pass-fail host port) test-id)) -;; (cdb:test-rollup-test_data-pass-fail test-id))) -;; -;; (define (rdb:pass-fail-counts test-id fail-count pass-count) -;; (if *runremote* -;; (let ((host (vector-ref *runremote* 0)) -;; (port (vector-ref *runremote* 1))) -;; ((rpc:procedure 'cdb:pass-fail-counts host port) test-id fail-count pass-count)) -;; (cdb:pass-fail-counts test-id fail-count pass-count))) -;; -;; ;; currently forces a flush of the queue -;; (define (rdb:tests-register-test db run-id test-name item-path) -;; (if *runremote* -;; (let ((host (vector-ref *runremote* 0)) -;; (port (vector-ref *runremote* 1))) -;; ((rpc:procedure 'cdb:tests-register-test host port) db run-id test-name item-path force-write: #t)) -;; (cdb:tests-register-test db run-id test-name item-path force-write: #t))) -;; -;; (define (rdb:flush-queue) -;; (if *runremote* -;; (let ((host (vector-ref *runremote* 0)) -;; (port (vector-ref *runremote* 1))) -;; ((rpc:procedure 'cdb:flush-queue host port))) -;; (cdb:flush-queue))) -;; Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -208,11 +208,11 @@ (let ((exinfo (vector-ref exit-info 2)) (logfna (if logpro-used (conc stepname ".html") ""))) ;; testing if procedures called in a remote call cause problems (ans: no or so I suspect) (open-run-close db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna)) (if logpro-used - (open-run-close db:test-set-log! #f test-id (conc stepname ".html"))) + (cdb:test-set-log! *runremote* test-id (conc stepname ".html"))) ;; set the test final status (let* ((this-step-status (cond ((and (eq? (vector-ref exit-info 2) 2) logpro-used) 'warn) ((eq? (vector-ref exit-info 2) 0) 'pass) (else 'fail))) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -683,11 +683,11 @@ (if (args:get-arg "-load-test-data") ;; has sub commands that are rdb: (open-run-close db:load-test-data db test-id)) (if (args:get-arg "-setlog") (let ((logfname (args:get-arg "-setlog"))) - (open-run-close db:test-set-log! db test-id logfname))) + (cdb:test-set-log! *runremote* #t test-id logfname))) (if (args:get-arg "-set-toplog") (open-run-close tests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog"))) (if (args:get-arg "-summarize-items") (open-run-close tests:summarize-items db run-id test-name #t)) ;; do force here (if (args:get-arg "-runstep") @@ -726,11 +726,11 @@ (debug:print-info 2 "running \"" cmd "\"") (change-directory startingdir) (set! exitstat (system cmd)) (set! *globalexitstatus* exitstat) ;; no necessary (change-directory testpath) - (open-run-close db:test-set-log! db test-id htmllogfile))) + (cdb:test-set-log! *runremote* #t test-id htmllogfile))) (let ((msg (args:get-arg "-m"))) (open-run-close db:teststep-set-status! db test-id stepname "end" exitstat msg logfile)) ))) (if (or (args:get-arg "-test-status") (args:get-arg "-set-values"))