Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -486,13 +486,14 @@ (directory-fold (lambda (file rem) (handle-exceptions exn (begin - (debug:print-info 0 *default-log-port* "unable to rotate log " file ", probably handled by another process.") - (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) - (print-call-chain (current-error-port))) + (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore.") + (debug:print 2 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) + ;; (print-call-chain (current-error-port)) ;; + ) (let* ((fullname (conc "logs/" file)) (mod-time (file-modification-time fullname)) (file-age (- (current-seconds) mod-time))) (hash-table-set! all-files file mod-time) (if (or (and (string-match "^.*.log" file) @@ -1712,11 +1713,11 @@ (debug:print 2 *default-log-port* "reading file " fullpath) (let ((real-age (- (current-seconds)(file-change-time fullpath)))) (if (< real-age age) (with-input-from-file fullpath read) (begin - (debug:print 2 *default-log-port* "file " fullpath " is too old (" real-age" seconds) to trust, skipping reading it") + (debug:print-info 2 *default-log-port* "file " fullpath " is too old (" real-age" seconds) to trust, skipping reading it") #f)))) (begin (debug:print 2 *default-log-port* "not reading file " fullpath) #f))) #f)) @@ -1986,11 +1987,13 @@ (result (if remote-host (with-input-from-pipe (conc "ssh " remote-host " cat /proc/cpuinfo") proc) (with-input-from-file "/proc/cpuinfo" proc)))) - (if (> result 0)(common:write-cached-info actual-host "num-cpus" result)) + (if (and (number? result) + (> result 0)) + (common:write-cached-info actual-host "num-cpus" result)) result)))) ;; wait for normalized cpu load to drop below maxload ;; (define (common:wait-for-normalized-load maxload msg remote-host #!optional (rem-tries 5)) @@ -2016,12 +2019,14 @@ (first (car loadavg)) (next (cadr loadavg)) (adjload (* maxload (max 1 numcpus))) ;; possible bug where numcpus (or could be maxload) is zero, crude fallback is to at least use 1 (loadjmp (- first next)) (adjwait (min (+ 300 (random 10)) (abs (* (+ (random 10)(/ (- 1000 count) 10) waitdelay) (- first adjload) )) )));; add some randomness to the time to break any alignment where netbatch dumps many jobs to machines simultaneously - (debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload - ", load: " first ", adjload: " adjload ", loadjmp: " loadjmp) + ;; let's let the user know once in a long while that load checking is happening but not constantly report it + (if (> (random 100) 75) ;; about 25% of the time + (debug:print-info 1 *default-log-port* "Checking cpuload on " (or remote-host "localhost") ", maxload: " maxload + ", load: " first ", adjload: " adjload ", loadjmp: " loadjmp)) (cond ((and (> first adjload) (> count 0)) (debug:print-info 0 *default-log-port* "server start delayed " adjwait " seconds due to load " first " exceeding max of " adjload " on server " (or remote-host (get-host-name)) " (normalized load-limit: " maxload ") " (if msg msg "")) (thread-sleep! adjwait) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -240,11 +240,13 @@ will substitute %s for the sheet name in generating multiple sheets) -o : output file for refdb2dat (defaults to stdout) -archive cmd : archive runs specified by selectors to one of disks specified in the [archive-disks] section. - cmd: keep-html, restore, save, save-remove, get (use -dest to set destination) + cmd: keep-html, restore, save, save-remove, get (use + -dest to set destination), -include and -exclude to include or + exclude files) -generate-html : create a simple html dashboard for browsing your runs -generate-html-structure : create a top level html veiw to list targets/runs and a Run view within each run directory. -list-run-time : list time requered to complete runs. It supports following switches -run-patt -target-patt -dumpmode -list-test-time : list time requered to complete each test in a run. It following following arguments Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -237,16 +237,21 @@ ;; Take advantage of a good place to exit if running the one-pass methodology (if (and (> (runs:dat-can-run-more-tests-count runsdat) 20) (args:get-arg "-one-pass")) (exit 0)) - (thread-sleep! (cond ;; BB: check with Matt. Should this sleep move to cond clauses below where we determine we have too many jobs running rather than each time the and condition above is true (which seems like always)? - ((> (runs:dat-can-run-more-tests-count runsdat) 20) + (thread-sleep! (cond ;; BB: check with Matt. Should this sleep move + ;; to cond clauses below where we determine we + ;; have too many jobs running rather than each + ;; time the and condition above is true (which + ;; seems like always)? + ((> (runs:dat-can-run-more-tests-count runsdat) 20) ;; original intent was - save cycles, wait a long time (if (runs:lownoise "waiting on tasks" 60)(debug:print-info 2 *default-log-port* "waiting for tasks to complete, sleeping briefly ...")) - (configf:lookup-number *configdat* "setup" "inter-test-delay" default: 0.1) ;; was 2 - );; obviously haven't had any work to do for a while - (else 0))) + 10) ;; obviously haven't had any work to do for a while + (else + ;; if have a number for inter-test-delay, use it, else don't delay much, maybe even zero? + (configf:lookup-number *configdat* "setup" "inter-test-delay" default: 0.01)))) (let* ((num-running (rmt:get-count-tests-running run-id)) (num-running-in-jobgroup (rmt:get-count-tests-running-in-jobgroup run-id jobgroup)) (job-group-limit (let ((jobg-count (configf:lookup *configdat* "jobgroups" jobgroup))) (if (string? jobg-count)