@@ -145,11 +145,11 @@ (define (tests:get-waitons test-name all-tests-registry) (let* ((config (tests:get-testconfig test-name all-tests-registry 'return-procs))) (let ((instr (if config (config-lookup config "requirements" "waiton") (begin ;; No config means this is a non-existant test - (debug:print 0 *default-log-port* "ERROR: non-existent required test \"" test-name "\"") + (debug:print-error 0 *default-log-port* "non-existent required test \"" test-name "\"") (exit 1)))) (instr2 (if config (config-lookup config "requirements" "waitor") ""))) (debug:print-info 8 *default-log-port* "waitons string is " instr ", waitors string is " instr2) @@ -159,36 +159,36 @@ (let ((res (instr))) (debug:print-info 8 *default-log-port* "waiton procedure results in string " res " for test " test-name) res)) ((string? instr) instr) (else - ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 *default-log-port* "ERROR: something went wrong in processing waitons for test " test-name) + ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " test-name) "")))) (newwaitors (string-split (cond ((procedure? instr2) (let ((res (instr2))) (debug:print-info 8 *default-log-port* "waitor procedure results in string " res " for test " test-name) res)) ((string? instr2) instr2) (else - ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 *default-log-port* "ERROR: something went wrong in processing waitons for test " test-name) + ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " test-name) ""))))) (values ;; the waitons (filter (lambda (x) (if (hash-table-ref/default all-tests-registry x #f) #t (begin - (debug:print 0 *default-log-port* "ERROR: test " test-name " has unrecognised waiton testname " x) + (debug:print-error 0 *default-log-port* "test " test-name " has unrecognised waiton testname " x) #f))) newwaitons) (filter (lambda (x) (if (hash-table-ref/default all-tests-registry x #f) #t (begin - (debug:print 0 *default-log-port* "ERROR: test " test-name " has unrecognised waiton testname " x) + (debug:print-error 0 *default-log-port* "test " test-name " has unrecognised waiton testname " x) #f))) newwaitors) config))))) ;; given waiting-test that is waiting on waiton-test extend test-patt appropriately @@ -302,11 +302,11 @@ (waiver-rx (regexp "^(\\S+)\\s+(.*)$")) (diff-rule "diff %file1% %file2%") (logpro-rule "diff %file1% %file2% | logpro %waivername%.logpro %waivername%.html")) (if (not (file-exists? test-rundir)) (begin - (debug:print 0 *default-log-port* "ERROR: test run directory is gone, cannot propagate waiver") + (debug:print-error 0 *default-log-port* "test run directory is gone, cannot propagate waiver") #f) (begin (push-directory test-rundir) (let ((result (if (null? waivers) #f @@ -468,11 +468,11 @@ (directory? path)) ;; can get #f here under some wierd conditions. why, unknown ... (begin (debug:print 4 *default-log-port* "Found path: " path) (change-directory path)) ;; (set! outputfilename (conc path "/" outputfilename))) - (debug:print 0 *default-log-port* "ERROR: summarize-items for run-id=" run-id ", test-name=" test-name ", no such path: " path)) + (debug:print-error 0 *default-log-port* "summarize-items for run-id=" run-id ", test-name=" test-name ", no such path: " path)) (debug:print 4 *default-log-port* "summarize-items with logf " logf ", outputfilename " outputfilename " and force " force) (if (or (equal? logf "logs/final.log") (equal? logf outputfilename) force) (let ((my-start-time (current-seconds)) @@ -822,11 +822,11 @@ ;; Move test specific stuff to a test unit FIXME one of these days (define (tests:sort-by-priority-and-waiton test-records) (let* ((mungepriority (lambda (priority) (if priority (let ((tmp (any->number priority))) - (if tmp tmp (begin (debug:print 0 *default-log-port* "ERROR: bad priority value " priority ", using 0") 0))) + (if tmp tmp (begin (debug:print-error 0 *default-log-port* "bad priority value " priority ", using 0") 0))) 0))) (all-tests (hash-table-keys test-records)) (all-waited-on (let loop ((hed (car all-tests)) (tal (cdr all-tests)) (res '())) @@ -1037,21 +1037,21 @@ (debug:print-info 4 *default-log-port* "hed=" hed " at top of loop") (let* ((config (tests:get-testconfig hed all-tests-registry 'return-procs)) (waitons (let ((instr (if config (config-lookup config "requirements" "waiton") (begin ;; No config means this is a non-existant test - (debug:print 0 *default-log-port* "ERROR: non-existent required test \"" hed "\", grep through your testconfigs to find and remove or create the test. Discarding and continuing.") + (debug:print-error 0 *default-log-port* "non-existent required test \"" hed "\", grep through your testconfigs to find and remove or create the test. Discarding and continuing.") "")))) (debug:print-info 8 *default-log-port* "waitons string is " instr) (string-split (cond ((procedure? instr) (let ((res (instr))) (debug:print-info 8 *default-log-port* "waiton procedure results in string " res " for test " hed) res)) ((string? instr) instr) (else - ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 *default-log-port* "ERROR: something went wrong in processing waitons for test " hed) + ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print-error 0 *default-log-port* "something went wrong in processing waitons for test " hed) "")))))) (if (not config) ;; this is a non-existant test called in a waiton. (if (null? tal) test-records (loop (car tal)(cdr tal))) @@ -1059,11 +1059,11 @@ (debug:print-info 8 *default-log-port* "waitons: " waitons) ;; check for hed in waitons => this would be circular, remove it and issue an ;; error (if (member hed waitons) (begin - (debug:print 0 *default-log-port* "ERROR: test " hed " has listed itself as a waiton, please correct this!") + (debug:print-error 0 *default-log-port* "test " hed " has listed itself as a waiton, please correct this!") (set! waitons (filter (lambda (x)(not (equal? x hed))) waitons)))) ;; (items (items:get-items-from-config config))) (if (not (hash-table-ref/default test-records hed #f)) (hash-table-set! test-records @@ -1163,11 +1163,11 @@ (debug:print-info 0 *default-log-port* "WARNING: failed to set meta info. Will try " remtries " more times") (set! remtries (- remtries 1)) (thread-sleep! 10) (tests:set-full-meta-info db test-id run-id minutes work-area (- remtries 1))) (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) - (debug:print 0 *default-log-port* "ERROR: tried for over a minute to update meta info and failed. Giving up") + (debug:print-error 0 *default-log-port* "tried for over a minute to update meta info and failed. Giving up") (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable.") (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (print "exn=" (condition->list exn)) (debug:print 0 *default-log-port* " status: " ((condition-property-accessor 'sqlite3 'status) exn)) (print-call-chain (current-error-port))))