Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -181,11 +181,12 @@ ;; KEYS ((get-key-val-pairs) (apply db:get-key-val-pairs dbstruct params)) ((get-keys) (db:get-keys dbstruct)) ((get-key-vals) (apply db:get-key-vals dbstruct params)) - ((get-targets) (db:get-targets dbstruct)) + ((get-target) (apply db:get-target dbstruct params)) + ((get-targets) (db:get-targets dbstruct)) ;; ARCHIVES ((test-get-archive-block-info) (apply db:test-get-archive-block-info dbstruct params)) ;; TESTS Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -798,22 +798,30 @@ (exit 2)))))) ;; additional house keeping (let* ((linktree (or (getenv "MT_LINKTREE") (if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))) (if linktree - (if (not (file-exists? linktree)) - (begin - (handle-exceptions - exn - (begin - (debug:print-error 0 *default-log-port* "Something went wrong when trying to create linktree dir at " linktree) - (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) - (exit 1)) - (create-directory linktree #t)))) + (begin + (if (not (file-exists? linktree)) + (begin + (handle-exceptions + exn + (begin + (debug:print-error 0 *default-log-port* "Something went wrong when trying to create linktree dir at " linktree) + (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) + (exit 1)) + (create-directory linktree #t)))) + (handle-exceptions + exn + (begin + (debug:print-error 0 *default-log-port* "Something went wrong when trying to create link to linktree at " *toppath*) + (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))) + (let ((tlink (conc *toppath* "/lt"))) + (if (not (file-exists? tlink)) + (create-symbolic-link linktree tlink))))) (begin (debug:print-error 0 *default-log-port* "linktree not defined in [setup] section of megatest.config") - ;; (exit 1) ))) (if (and *toppath* (directory-exists? *toppath*)) (setenv "MT_RUN_AREA_HOME" *toppath*) (begin Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -350,10 +350,13 @@ (rmt:send-receive 'get-key-vals #f (list run-id))) (define (rmt:get-targets) (rmt:send-receive 'get-targets #f '())) +(define (rmt:get-target run-id) + (rmt:send-receive 'get-target run-id (list run-id))) + ;;====================================================================== ;; T E S T S ;;====================================================================== ;; Just some syntatic sugar Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -911,31 +911,45 @@ (else t))))) tests)) ;; move all the miscellanea into this struct ;; -(defstruct runs:gendat inc-results inc-results-last-update inc-results-fmt) +(defstruct runs:gendat inc-results inc-results-last-update inc-results-fmt run-info runname target) (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 + inc-results-fmt: "~12a~12a~20a~12a~40a\n" ;; state status time duration test-name item-path + run-info: #f + runname: #f + target: #f ) ) (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))) + (let* ((run-dat (or (runs:gendat-run-info *runs:general-data*)(rmt:get-run-info run-id))) + (runname (or (runs:gendat-runname *runs:general-data*) + (db:get-value-by-header (db:get-rows run-dat) + (db:get-header run-dat) "runname"))) + (target (or (runs:gendat-target *runs:general-data*)(rmt:get-target run-id))) + (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))) + (if (not (runs:gendat-run-info *runs:general-data*)) + (runs:gendat-run-info-set! *runs:general-data* run-dat)) + (if (not (runs:gendat-runname *runs:general-data*)) + (runs:gendat-runname-set! *runs:general-data* runname)) + (if (not (runs:gendat-target *runs:general-data*)) + (runs:gendat-target-set! *runs:general-data* target)) (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)) @@ -950,20 +964,19 @@ (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" 600) - (format #t fmt "State" "Status" "Start Time" "Duration" "Test name" "Item path")) + (format #t fmt "State" "Status" "Start Time" "Duration" "Test 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) + (conc "lt/" target "/" runname "/" test-name (if (string-null? item-path) "" (conc "/" 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.