Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -956,11 +956,11 @@ (define (seconds->time-string sec) (time->string (seconds->local-time sec) "%H:%M:%S")) -(define (seconds->work-week/day-time sec) +(define (sbeconds->work-week/day-time sec) (time->string (seconds->local-time sec) "ww%V.%u %H:%M")) (define (seconds->work-week/day sec) (time->string @@ -970,11 +970,11 @@ (time->string (seconds->local-time sec) "%yww%V.%w")) (define (seconds->year-work-week/day-time sec) (time->string - (seconds->local-time sec) "%yww%V.%w %H:%M")) + (seconds->local-time sec) "%Yww%V.%w %H:%M")) (define (seconds->quarter sec) (case (string->number (time->string (seconds->local-time sec) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -1,7 +1,7 @@ -;; Copyright 2006-2013, Matthew Welland. +;; Copyright 2006-2016, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the @@ -9,11 +9,11 @@ ;; PURPOSE. ;; strftime('%m/%d/%Y %H:%M:%S','now','localtime') (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) - posix-extras directory-utils pathname-expand) + posix-extras directory-utils pathname-expand defstruct format) (import (prefix sqlite3 sqlite3:)) (declare (unit runs)) (declare (uses db)) (declare (uses common)) @@ -162,18 +162,10 @@ (if (runs:lownoise (conc "maxjobgroup " jobgroup) 60) (debug:print 1 *default-log-port* "WARNING: number of jobs " num-running-in-jobgroup " in jobgroup \"" jobgroup "\" exceeds limit of " job-group-limit)) #t) (else #f)))) -;; ;; lets use the debugger eh? -;; (debugger-start start: 15) -;; (debugger-trace-var "runs:can-run-more-tests" "") -;; (debugger-trace-var "can-not-run-more" can-not-run-more) -;; (debugger-trace-var "num-running" num-running) -;; (debugger-trace-var "num-running-in-jobgroup" num-running-in-jobgroup) -;; (debugger-trace-var "job-group-limit" job-group-limit) -;; (debugger-pauser) (list (not can-not-run-more) num-running num-running-in-jobgroup max-concurrent-jobs job-group-limit))))) ;; test-names: Comma separated patterns same as test-patts but used in selection ;; of tests to run. The item portions are not respected. @@ -498,19 +490,11 @@ "\n (null? non-completed): " (null? non-completed) "\n reruns: " reruns "\n items: " items "\n can-run-more: " can-run-more) - ;; lets use the debugger eh? -;; (debugger-start start: 2) -;; (debugger-trace-var "runs:expand-items" "") -;; (debugger-trace-var "can-run-more" can-run-more) -;; (debugger-trace-var "hed" hed) -;; (debugger-trace-var "prereqs-not-met" (runs:pretty-string prereqs-not-met)) -;; (debugger-pauser) - - (cond + (cond ;; all prereqs met, fire off the test ;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch ((and (not (member 'toplevel testmode)) (member (hash-table-ref/default test-registry (db:test-make-full-name hed item-path) 'n/a) @@ -797,10 +781,11 @@ ;; well, first lets see if cpu load throttling is enabled. If so wait around until the ;; average cpu load is under the threshold before continuing (if (configf:lookup *configdat* "jobtools" "maxload") ;; only gate if maxload is specified (common:wait-for-cpuload maxload numcpus waitdelay)) (run:test run-id run-info keyvals runname test-record flags #f test-registry all-tests-registry) + (runs:incremental-print-results run-id) (hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'running) (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) ;; (thread-sleep! *global-delta*) (if (or (not (null? tal))(not (null? reg))) (list (runs:queue-next-hed tal reg reglen regfull) @@ -924,10 +909,65 @@ t)) ((DELETED) #f) (else t))))) tests)) +;; move all the miscellanea into this struct +;; +(defstruct runs:gendat inc-results inc-results-last-update inc-results-fmt) + +(define *runs:general-data* + (make-runs:gendat + inc-results: (make-hash-table) + inc-results-last-update: 0 + inc-results-fmt: "~12a~12a~20a~12a~20a~25a\n" ;; state status time duration test-name item-path + ) +) + +(define (runs:incremental-print-results run-id) + (let ((curr-sec (current-seconds))) + (if (> (- curr-sec (runs:gendat-inc-results-last-update *runs:general-data*)) 5) ;; at least five seconds since last update + (let ((testsdat (rmt:get-tests-for-run run-id "%" '() '() + #f #f + #f ;; hide/not-hide + #f ;; sort-by + #f ;; sort-order + #f ;; get full data (not 'shortlist) + (runs:gendat-inc-results-last-update *runs:general-data*) ;; last update time + 'dashboard))) + (for-each + (lambda (testdat) + (let* ((test-id (db:test-get-id testdat)) + (prevdat (hash-table-ref/default (runs:gendat-inc-results *runs:general-data*) + (conc run-id "," test-id) #f)) + (test-name (db:test-get-testname testdat)) + (item-path (db:test-get-item-path testdat)) + (state (db:test-get-state testdat)) + (status (db:test-get-status testdat)) + (event-time (db:test-get-event_time testdat)) + (duration (db:test-get-run_duration testdat))) + (if (and (not (member state '("DELETED" "REMOTEHOSTSTART" "RUNNING" "LAUNCHED""NOT_STARTED"))) + (not (and prevdat + (equal? state (db:test-get-state prevdat)) + (equal? status (db:test-get-status prevdat))))) + (let ((fmt (runs:gendat-inc-results-fmt *runs:general-data*)) + (dtime (seconds->year-work-week/day-time event-time))) + (if (runs:lownoise "inc-print" 120) + (format #t fmt "State" "Status" "Start Time" "Duration" "Test name" "Item path")) + (debug:print 0 *default-log-port* "fmt: " fmt " state: " state " status: " status " test-name: " test-name " item-path: " item-path " dtime: " dtime) + ;; (debug:print 0 #f "event-time: " event-time " duration: " duration) + (format #t fmt + state + status + dtime + (seconds->hr-min-sec duration) + test-name + item-path) + (hash-table-set! (runs:gendat-inc-results *runs:general-data*) (conc run-id "," test-id) testdat))))) + testsdat))) + (runs:gendat-inc-results-last-update-set! *runs:general-data* (- curr-sec 10)))) + ;; every time though the loop increment the test/itempatt val. ;; when the min is > max-allowed and none running then force exit ;; (define *max-tries-hash* (make-hash-table)) @@ -971,10 +1011,12 @@ (let loop ((hed (car sorted-test-names)) (tal (cdr sorted-test-names)) (reg '()) ;; registered, put these at the head of tal (reruns '())) + + (runs:incremental-print-results run-id) (if (not (null? reruns))(debug:print-info 4 *default-log-port* "reruns=" reruns)) ;; Here we mark any old defunct tests as incomplete. Do this every fifteen minutes ;; moving this to a parallel thread and just run it once. @@ -1034,10 +1076,11 @@ (runs:queue-next-tal tal reg reglen regfull) (runs:queue-next-reg tal reg reglen regfull) reruns)))) ;; (loop (car tal)(cdr tal) reg reruns)))) + (runs:incremental-print-results run-id) (debug:print 4 *default-log-port* "TOP OF LOOP => " "test-name: " test-name "\n test-record " test-record "\n hed: " hed "\n itemdat: " itemdat