@@ -56,11 +56,11 @@ (work-area-writeable (file-write-access? work-area)) (db (handle-exceptions ;; open the db if area writeable or db pre-existing. open in-mem otherwise. if exception, open in-mem exn (begin (print-call-chain (current-error-port)) - (debug:print 2 #f "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test" + (debug:print 2 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test" ((condition-property-accessor 'exn 'message) exn)) (set! dbexists #f) ;; must force re-creation of tables, more tom-foolery (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access (if (or work-area-writeable dbexists) @@ -85,11 +85,11 @@ ;; now let's test that everything is correct (handle-exceptions exn (begin (print-call-chain (current-error-port)) - (debug:print 0 #f "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file " + (debug:print 0 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file " dbpath ".\n " ((condition-property-accessor 'exn 'message) exn)) #f) ;; Is there a cheaper single line operation that will check for existance of a table ;; and raise an exception ? @@ -105,19 +105,19 @@ ;; find and open the testdat.db file for an existing test (define (tdb:open-test-db-by-test-id test-id #!key (work-area #f)) (let* ((test-path (if work-area work-area (rmt:test-get-rundir-from-test-id test-id)))) - (debug:print 3 #f "TEST PATH: " test-path) + (debug:print 3 *default-log-port* "TEST PATH: " test-path) (open-test-db test-path))) ;; find and open the testdat.db file for an existing test (define (tdb:open-test-db-by-test-id-local dbstruct run-id test-id #!key (work-area #f)) (let* ((test-path (if work-area work-area (db:test-get-rundir-from-test-id dbstruct run-id test-id)))) - (debug:print 3 #f "TEST PATH: " test-path) + (debug:print 3 *default-log-port* "TEST PATH: " test-path) (open-test-db test-path))) ;; find and open the testdat.db file for an existing test (define (tdb:open-run-close-db-by-test-id-local dbstruct run-id test-id work-area proc . params) (let* ((test-path (if work-area @@ -125,11 +125,11 @@ (db:test-get-rundir-from-test-id dbstruct run-id test-id))) (tdb (open-test-db test-path))) (apply proc tdb params))) (define (tdb:testdb-initialize db) - (debug:print 11 #f "db:testdb-initialize START") + (debug:print 11 *default-log-port* "db:testdb-initialize START") (sqlite3:with-transaction db (lambda () (for-each (lambda (sqlcmd) @@ -171,11 +171,11 @@ id INTEGER PRIMARY KEY, var TEXT, val TEXT, ackstate INTEGER DEFAULT 0, CONSTRAINT metadat_constraint UNIQUE (var));")))) - (debug:print 11 #f "db:testdb-initialize END")) + (debug:print 11 *default-log-port* "db:testdb-initialize END")) ;; This routine moved to db:read-test-data ;; (define (tdb:read-test-data tdb test-id categorypatt) (let ((res '())) @@ -208,11 +208,11 @@ ;; NOTE: Run this local with #f for db !!! (define (tdb:load-test-data run-id test-id) (let loop ((lin (read-line))) (if (not (eof-object? lin)) (begin - (debug:print 4 #f lin) + (debug:print 4 *default-log-port* lin) (rmt:csv->test-data run-id test-id lin) (loop (read-line))))) ;; roll up the current results. ;; FIXME: Add the status too (rmt:test-data-rollup run-id test-id #f)) @@ -220,11 +220,11 @@ ;; NOTE: Run this local with #f for db !!! (define (tdb:load-logpro-data run-id test-id) (let loop ((lin (read-line))) (if (not (eof-object? lin)) (begin - (debug:print 4 #f lin) + (debug:print 4 *default-log-port* lin) (rmt:csv->test-data run-id test-id lin) (loop (read-line))))) ;; roll up the current results. ;; FIXME: Add the status too (rmt:test-data-rollup run-id test-id #f)) @@ -246,17 +246,17 @@ ;; (define (tdb:get-steps-table steps);; organise the steps for better readability (let ((res (make-hash-table))) (for-each (lambda (step) - (debug:print 6 #f "step=" step) + (debug:print 6 *default-log-port* "step=" step) (let ((record (hash-table-ref/default res (tdb:step-get-stepname step) ;; stepname start end status Duration Logfile (vector (tdb:step-get-stepname step) "" "" "" "" "")))) - (debug:print 6 #f "record(before) = " record + (debug:print 6 *default-log-port* "record(before) = " record "\nid: " (tdb:step-get-id step) "\nstepname: " (tdb:step-get-stepname step) "\nstate: " (tdb:step-get-state step) "\nstatus: " (tdb:step-get-status step) "\ntime: " (tdb:step-get-event_time step)) @@ -270,11 +270,11 @@ ((end) (vector-set! record 2 (any->number (tdb:step-get-event_time step))) (vector-set! record 3 (tdb: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 #f "record[1]=" (vector-ref record 1) + (debug:print 4 *default-log-port* "record[1]=" (vector-ref record 1) ", startt=" startt ", endt=" endt ", get-status: " (tdb:step-get-status step)) (if (and (number? startt)(number? endt)) (seconds->hr-min-sec (- endt startt)) "-1"))) (if (> (string-length (tdb:step-get-logfile step)) @@ -283,11 +283,11 @@ (else (vector-set! record 2 (tdb:step-get-state step)) (vector-set! record 3 (tdb:step-get-status step)) (vector-set! record 4 (tdb:step-get-event_time step)))) (hash-table-set! res (tdb:step-get-stepname step) record) - (debug:print 6 #f "record(after) = " record + (debug:print 6 *default-log-port* "record(after) = " record "\nid: " (tdb:step-get-id step) "\nstepname: " (tdb:step-get-stepname step) "\nstate: " (tdb:step-get-state step) "\nstatus: " (tdb:step-get-status step) "\ntime: " (tdb:step-get-event_time step)))) @@ -307,17 +307,17 @@ (define (tdb:get-steps-table-list steps) ;; organise the steps for better readability (let ((res (make-hash-table))) (for-each (lambda (step) - (debug:print 6 #f "step=" step) + (debug:print 6 *default-log-port* "step=" step) (let ((record (hash-table-ref/default res (tdb:step-get-stepname step) ;; stepname start end status (vector (tdb:step-get-stepname step) "" "" "" "" "")))) - (debug:print 6 #f "record(before) = " record + (debug:print 6 *default-log-port* "record(before) = " record "\nid: " (tdb:step-get-id step) "\nstepname: " (tdb:step-get-stepname step) "\nstate: " (tdb:step-get-state step) "\nstatus: " (tdb:step-get-status step) "\ntime: " (tdb:step-get-event_time step)) @@ -331,11 +331,11 @@ ((end) (vector-set! record 2 (any->number (tdb:step-get-event_time step))) (vector-set! record 3 (tdb: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 #f "record[1]=" (vector-ref record 1) + (debug:print 4 *default-log-port* "record[1]=" (vector-ref record 1) ", startt=" startt ", endt=" endt ", get-status: " (tdb:step-get-status step)) (if (and (number? startt)(number? endt)) (seconds->hr-min-sec (- endt startt)) "-1"))) (if (> (string-length (tdb:step-get-logfile step)) @@ -344,11 +344,11 @@ (else (vector-set! record 2 (tdb:step-get-state step)) (vector-set! record 3 (tdb:step-get-status step)) (vector-set! record 4 (tdb:step-get-event_time step)))) (hash-table-set! res (tdb:step-get-stepname step) record) - (debug:print 6 #f "record(after) = " record + (debug:print 6 *default-log-port* "record(after) = " record "\nid: " (tdb:step-get-id step) "\nstepname: " (tdb:step-get-stepname step) "\nstate: " (tdb:step-get-state step) "\nstatus: " (tdb:step-get-status step) "\ntime: " (tdb:step-get-event_time step)))) @@ -395,7 +395,7 @@ (if (sqlite3:database? tdb) (begin (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);" cpuload diskfree minutes) (sqlite3:finalize! tdb)) - (debug:print 2 #f "Can't update testdat.db for test " test-id " read-only or non-existant")))) + (debug:print 2 *default-log-port* "Can't update testdat.db for test " test-id " read-only or non-existant"))))