Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -353,12 +353,15 @@ (set! *didsomething* #t))) (if (args:get-arg "-refdb2dat") (let* ((input-db (args:get-arg "-refdb2dat")) (out-file (args:get-arg "-o")) - (out-port (if out-file (open-output-file out-file) (current-output-port))) (out-fmt (or (args:get-arg "-dumpmode") "scheme")) + (out-port (if (and out-file + (not (equal? out-fmt "sqlite3"))) + (open-output-file out-file) + (current-output-port))) (res-data (configf:read-refdb input-db)) (data (car res-data)) (msg (cadr res-data))) (if (not data) (debug:print 0 data) ;; some error occurred @@ -386,10 +389,22 @@ (lambda (sheetname) (print "data[\"" sheetname "\"] = {}")) initproc2: (lambda (sheetname sectionname) (print "data[\"" sheetname "\"][\"" sectionname "\"] = {}")))) + ((sqlite3) + (let* ((db-file (or out-file (pathname-file input-db))) + (db-exists (file-exists? db-file)) + (db (sqlite3:open-database db-file))) + (if (not db-exists)(sqlite3:execute db "CREATE TABLE data (sheet,section,var,val);")) + (configf:map-all-hier-alist + data + (lambda (sheetname sectionname varname val) + (sqlite3:execute db + "INSERT OR REPLACE INTO data (sheet,section,var,val) VALUES (?,?,?,?);" + sheetname sectionname varname val))) + (sqlite3:finalize! db))) (else (pp data)))))) (if out-file (close-output-port out-port)) (exit) ;; yes, bending the rules here - need to exit since this is a utility )) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -619,11 +619,12 @@ (if (vector? t) (conc (db:test-get-state t) "/" (db:test-get-status t)) (conc " WARNING: t is not a vector=" t ))) prereqs-not-met) ", ") ") fails: " fails) - (if (not (null? prereqs-not-met)) + (if (and (not (null? prereqs-not-met)) + (runs:lownoise (conc "waiting on tests " prereqs-not-met hed) 60)) (debug:print-info 2 "waiting on tests; " (string-intersperse (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) ", "))) ;; Don't know at this time if the test have been launched at some time in the past ;; i.e. is this a re-launch? (debug:print-info 4 "run-limits-info = " run-limits-info) @@ -726,18 +727,20 @@ (else (debug:print 4 "FAILS: " fails) ;; If one or more of the prereqs-not-met are FAIL then we can issue ;; a message and drop hed from the items to be processed. ;; (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) - (if (not (null? prereqs-not-met)) + (if (and (not (null? prereqs-not-met)) + (runs:lownoise (conc "waiting on tests " prereqs-not-met hed) 60)) (debug:print-info 1 "waiting on tests; " (string-intersperse (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) ", "))) (if (null? fails) (begin ;; couldn't run, take a breather - (debug:print-info 0 "Waiting for more work to do...") + (if (runs:lownoise "Waiting for more work to do..." 60) + (debug:print-info 0 "Waiting for more work to do...")) (thread-sleep! 1) (list (car newtal)(cdr newtal) reg reruns)) ;; the waiton is FAIL so no point in trying to run hed ever again (if (or (not (null? reg))(not (null? tal))) (if (vector? hed) @@ -754,11 +757,12 @@ reruns ;; WAS: (cons hed reruns) ;; but that makes no sense? )) (let ((nth-try (hash-table-ref/default test-registry hed 0))) (cond ((member "RUNNING" (map db:test-get-state prereqs-not-met)) - (debug:print 0 "WARNING: test " hed " has possible RUNNING prerequisites, don't give up on it yet.") + (if (runs:lownoise (conc "possible RUNNING prerequistes " hed) 60) + (debug:print 0 "WARNING: test " hed " has possible RUNNING prerequisites, don't give up on it yet.")) (thread-sleep! 4) (list (runs:queue-next-hed newtal reg reglen regfull) (runs:queue-next-tal newtal reg reglen regfull) (runs:queue-next-reg newtal reg reglen regfull) reruns)) @@ -766,11 +770,12 @@ (and (number? nth-try) (< nth-try 10))) (hash-table-set! test-registry hed (if (number? nth-try) (+ nth-try 1) 0)) - (debug:print 0 "WARNING: not removing test " hed " from queue although it may not be runnable due to FAILED prerequisites") + (if (runs:lownoise (conc "not removing test " hed) 60) + (debug:print 1 "WARNING: not removing test " hed " from queue although it may not be runnable due to FAILED prerequisites")) ;; may not have processed correctly. Could be a race condition in your test implementation? Dropping test " hed) ;; " as it has prerequistes that are FAIL. (NOTE: hed is not a vector)") (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) ;; (list hed tal reg reruns) ;; (list (car newtal)(cdr newtal) reg reruns) ;; (hash-table-set! test-registry hed 'removed) @@ -777,19 +782,26 @@ (list (runs:queue-next-hed newtal reg reglen regfull) (runs:queue-next-tal newtal reg reglen regfull) (runs:queue-next-reg newtal reg reglen regfull) reruns)) ((symbol? nth-try) - (debug:print 0 "WARNING: test " hed " has FAILED prerequisites or other issue. Internal state " nth-try " will be overridden and we'll retry.") - (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "KEEP_TRYING" #f) - (hash-table-set! test-registry hed 0) - (list (runs:queue-next-hed newtal reg reglen regfull) - (runs:queue-next-tal newtal reg reglen regfull) - (runs:queue-next-reg newtal reg reglen regfull) - reruns)) + (if (eq? nth-try 'removed) ;; removed is removed - drop it NOW + (if (null? tal) + #f ;; yes, really + (list (car tal)(cdr tal) reg reruns)) + (begin + (if (runs:lownoise (conc "FAILED prerequisites or other issue" hed) 60) + (debug:print 0 "WARNING: test " hed " has FAILED prerequisites or other issue. Internal state " nth-try " will be overridden and we'll retry.")) + (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "KEEP_TRYING" #f) + (hash-table-set! test-registry hed 0) + (list (runs:queue-next-hed newtal reg reglen regfull) + (runs:queue-next-tal newtal reg reglen regfull) + (runs:queue-next-reg newtal reg reglen regfull) + reruns)))) (else - (debug:print 0 "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now.") + (if (runs:lownoise (conc "FAILED prerequitests and we tried" hed) 60) + (debug:print 0 "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now.")) ;; (debug:print 0 " prereqs: " prereqs-not-met) (hash-table-set! test-registry hed 'removed) (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "TEN_STRIKES" #f) (mt:roll-up-pass-fail-counts run-id test-name item-path "FAIL") ;; treat as FAIL (list (if (null? tal)(car newtal)(car tal)) @@ -911,11 +923,12 @@ ;; Fast skip of tests that are already "COMPLETED" - NO! Cannot do that as the items may not have been expanded yet :( ;; (if (member (hash-table-ref/default test-registry tfullname #f) '(DONOTRUN removed)) ;; *common:cant-run-states-sym*) ;; '(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE)) (begin - (debug:print-info 0 "Skipping test " tfullname " as it has been marked do not run due to being completed or not runnable") + (if (runs:lownoise (conc "been marked do not run " tfullname) 60) + (debug:print-info 0 "Skipping test " tfullname " as it has been marked do not run due to being completed or not runnable")) (if (or (not (null? tal))(not (null? reg))) (loop (runs:queue-next-hed tal reg reglen regfull) (runs:queue-next-tal tal reg reglen regfull) (runs:queue-next-reg tal reg reglen regfull) reruns))))