@@ -67,35 +67,35 @@ "Test date: ")) (list (iup:label "" #:expand "VERTICAL")))) (apply iup:vbox ; #:expand "YES" (list (store-label "testname" - (iup:label (db:test-get-testname testdat) #:expand "HORIZONTAL") - (lambda (testdat)(db:test-get-testname testdat))) + (iup:label (db:test-testname testdat) #:expand "HORIZONTAL") + (lambda (testdat)(db:test-testname testdat))) (store-label "item-path" - (iup:label (db:test-get-item-path testdat) #:expand "HORIZONTAL") - (lambda (testdat)(db:test-get-item-path testdat))) + (iup:label (db:test-item-path testdat) #:expand "HORIZONTAL") + (lambda (testdat)(db:test-item-path testdat))) (store-label "teststate" - (iup:label (db:test-get-state testdat) #:expand "HORIZONTAL") + (iup:label (db:test-state testdat) #:expand "HORIZONTAL") (lambda (testdat) - (db:test-get-state testdat))) - (let ((lbl (iup:label (db:test-get-status testdat) #:expand "HORIZONTAL"))) + (db:test-state testdat))) + (let ((lbl (iup:label (db:test-status testdat) #:expand "HORIZONTAL"))) (hash-table-set! widgets "teststatus" (lambda (testdat) - (let ((newstatus (db:test-get-status testdat)) + (let ((newstatus (db:test-status testdat)) (oldstatus (iup:attribute lbl "TITLE"))) (if (not (equal? oldstatus newstatus)) (begin - (iup:attribute-set! lbl "FGCOLOR" (car (gutils:get-color-for-state-status (db:test-get-state testdat) - (db:test-get-status testdat)))) - (iup:attribute-set! lbl "TITLE" (db:test-get-status testdat))))))) + (iup:attribute-set! lbl "FGCOLOR" (car (gutils:get-color-for-state-status (db:test-state testdat) + (db:test-status testdat)))) + (iup:attribute-set! lbl "TITLE" (db:test-status testdat))))))) lbl) (store-label "testcomment" (iup:label "TestComment " #:expand "HORIZONTAL") (lambda (testdat) - (let ((newcomment (db:test-get-comment testdat))) + (let ((newcomment (db:test-comment testdat))) (if *dashboard-comment-share-slot* (if (not (equal? (iup:attribute *dashboard-comment-share-slot* "VALUE") newcomment)) (iup:attribute-set! *dashboard-comment-share-slot* "VALUE" @@ -103,16 +103,16 @@ newcomment))) (store-label "testid" (iup:label "TestId " #:expand "HORIZONTAL") (lambda (testdat) - (db:test-get-id testdat))) + (db:test-id testdat))) (store-label "testdate" (iup:label "TestDate " #:expand "HORIZONTAL") (lambda (testdat) - (seconds->work-week/day-time (db:test-get-event_time testdat)))) + (seconds->work-week/day-time (db:test-event_time testdat)))) ))))) ;;====================================================================== ;; Test meta panel ;;====================================================================== @@ -157,11 +157,11 @@ ;;====================================================================== ;; Run info panel ;;====================================================================== (define (run-info-panel db keydat testdat runname) - (let* ((run-id (db:test-get-run_id testdat)) + (let* ((run-id (db:test-run_id testdat)) (rundat (db:get-run-info db run-id)) (header (db:get-header rundat)) (event_time (db:get-value-by-header (db:get-rows rundat) (db:get-header rundat) "event_time"))) @@ -206,32 +206,32 @@ (apply iup:vbox ; #:expand "YES" (list ;; NOTE: Yes, the host can change! (store-label "HostName" (iup:label ;; (sdb:qry 'getstr - (db:test-get-host testdat) ;; ) + (db:test-host testdat) ;; ) #:expand "HORIZONTAL") - (lambda (testdat)(db:test-get-host testdat))) + (lambda (testdat)(db:test-host testdat))) (store-label "DiskFree" - (iup:label (conc (db:test-get-diskfree testdat)) #:expand "HORIZONTAL") - (lambda (testdat)(conc (db:test-get-diskfree testdat)))) + (iup:label (conc (db:test-diskfree testdat)) #:expand "HORIZONTAL") + (lambda (testdat)(conc (db:test-diskfree testdat)))) (store-label "CPULoad" - (iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL") - (lambda (testdat)(conc (db:test-get-cpuload testdat)))) + (iup:label (conc (db:test-cpuload testdat)) #:expand "HORIZONTAL") + (lambda (testdat)(conc (db:test-cpuload testdat)))) (store-label "RunDuration" - (iup:label (conc (seconds->hr-min-sec (db:test-get-run_duration testdat))) #:expand "HORIZONTAL") - (lambda (testdat)(conc (seconds->hr-min-sec (db:test-get-run_duration testdat))))) + (iup:label (conc (seconds->hr-min-sec (db:test-run_duration testdat))) #:expand "HORIZONTAL") + (lambda (testdat)(conc (seconds->hr-min-sec (db:test-run_duration testdat))))) (store-label "LogFile" - (iup:label (conc (db:test-get-final_logf testdat)) #:expand "HORIZONTAL") - (lambda (testdat)(conc (db:test-get-final_logf testdat)))) + (iup:label (conc (db:test-final_logf testdat)) #:expand "HORIZONTAL") + (lambda (testdat)(conc (db:test-final_logf testdat)))) (store-label "ProcessId" - (iup:label (conc (db:test-get-process_id testdat)) #:expand "HORIZONTAL") - (lambda (testdat)(conc (db:test-get-process_id testdat)))) + (iup:label (conc (db:test-process_id testdat)) #:expand "HORIZONTAL") + (lambda (testdat)(conc (db:test-process_id testdat)))) (store-label "Uname" (iup:label " " #:expand "HORIZONTAL") ;; #:wordwrap "YES") (lambda (testdat) ;; (sdb:qry 'getstr - (db:test-get-uname testdat))) ;; ) + (db:test-uname testdat))) ;; ) ))))) ;; if there is a submegatest create a button to launch dashboard in that area ;; (define (submegatest-panel dbstruct keydat testdat runname testconfig) @@ -249,12 +249,12 @@ ;; use a global for setting the buttons colors ;; state status teststeps (define *state-status* (vector #f #f #f)) (define (update-state-status-buttons testdat) - (let* ((state (db:test-get-state testdat)) - (status (db:test-get-status testdat)) + (let* ((state (db:test-state testdat)) + (status (db:test-status testdat)) (color (car (gutils:get-color-for-state-status state status)))) ((vector-ref *state-status* 0) state color) ((vector-ref *state-status* 1) status color))) (define *dashboard-test-db* #t) @@ -275,11 +275,11 @@ (let ((txtbox (iup:textbox #:action (lambda (val a b) (rmt:test-set-state-status-by-id run-id test-id #f #f b) ;; IDEA: Just set a variable with the proc to call? (rmt:test-set-state-status-by-id run-id test-id #f #f b) (set! newcomment b)) - #:value (db:test-get-comment testdat) + #:value (db:test-comment testdat) #:expand "HORIZONTAL"))) (set! wtxtbox txtbox) txtbox)) (apply iup:hbox @@ -287,11 +287,11 @@ (let* ((btns (map (lambda (state) (let ((btn (iup:button state #:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10" #:action (lambda (x) (rmt:test-set-state-status-by-id run-id test-id state #f #f) - (db:test-set-state! testdat state))))) + (db:test-state-set! testdat state))))) btn)) (map cadr *common:std-states*)))) ;; (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "KILLED" "KILLREQ")))) (vector-set! *state-status* 0 (lambda (state color) (for-each @@ -320,11 +320,11 @@ (if (not *dashboard-comment-share-slot*) (set! *dashboard-comment-share-slot* wtxtbox))) )))) (begin (rmt:test-set-state-status-by-id run-id test-id #f status #f) - (db:test-set-status! testdat status)))))))) + (db:test-status-set! testdat status)))))))) btn)) (map cadr *common:std-statuses*)))) ;; (list "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED" "SKIP")))) (vector-set! *state-status* 1 (lambda (status color) (for-each @@ -378,34 +378,34 @@ (if wpatt (if (string-match wregx b) (iup:attribute-set! wmesg "TITLE" (conc "Comment matches " wpatt)) (iup:attribute-set! wmesg "TITLE" (conc "Comment does not match " wpatt)) ))) - #:value (if ovrdval ovrdval (db:test-get-comment testdat)) + #:value (if ovrdval ovrdval (db:test-comment testdat)) #:expand "HORIZONTAL")) (dlog #f)) (set! dlog (iup:dialog ;; #:close_cb (lambda (a)(exit)) ; #:expand "YES" #:title "SET WAIVER" (iup:vbox ; #:expand "YES" (iup:label (conc "Enter justification for waiving test " - (db:test-get-testname testdat) - (if (equal? (db:test-get-item-path testdat) "") + (db:test-testname testdat) + (if (equal? (db:test-item-path testdat) "") "" - (conc "/" (db:test-get-item-path testdat))))) + (conc "/" (db:test-item-path testdat))))) wmesg ;; the informational msg on whether it matches comnt (iup:hbox (iup:button "Apply and Close " #:expand "HORIZONTAL" #:action (lambda (obj) (let ((comment (iup:attribute comnt "VALUE")) - (test-id (db:test-get-id testdat))) + (test-id (db:test-id testdat))) (if (or (not wpatt) (string-match wregx comment)) (begin (rmt:test-set-state-status-by-id run-id test-id #f "WAIVED" comment) - (db:test-set-status! testdat "WAIVED") + (db:test-status-set! testdat "WAIVED") (cmtcmd comment) (iup:destroy! dlog)))))) (iup:button "Cancel" #:expand "HORIZONTAL" #:action (lambda (obj) @@ -425,11 +425,11 @@ (request-update #t)) (if (not testdat) (begin (debug:print 2 "ERROR: No test data found for test " test-id ", exiting") (exit 1)) - (let* (;; (run-id (if testdat (db:test-get-run_id testdat) #f)) + (let* (;; (run-id (if testdat (db:test-run_id testdat) #f)) (test-registry (tests:get-all)) (keydat (if testdat (rmt:get-key-val-pairs run-id) #f)) (rundat (if testdat (rmt:get-run-info run-id) #f)) (runname (if testdat (db:get-value-by-header (db:get-rows rundat) (db:get-header rundat) @@ -437,16 +437,16 @@ ;; (tdb (tdb:open-test-db-by-test-id-local dbstruct run-id test-id)) ;; These next two are intentional bad values to ensure errors if they should not ;; get filled in properly. (logfile "/this/dir/better/not/exist") (rundir (if testdat - (db:test-get-rundir testdat) + (db:test-rundir testdat) logfile)) ;; (testdat-path (conc rundir "/testdat.db")) ;; this gets recalculated until found (teststeps (if testdat (tests:get-compressed-steps #f run-id test-id) '())) - (testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ...")) - (testname (if testdat (db:test-get-testname testdat) "n/a")) + (testfullname (if testdat (db:test-fullname testdat) "Gathering data ...")) + (testname (if testdat (db:test-testname testdat) "n/a")) ;; (tests:get-testconfig testdat testname 'return-procs)) (testmeta (if testdat (let ((tm (rmt:testmeta-get-record testname))) (if tm tm (make-db:testmeta))) (make-db:testmeta))) @@ -455,11 +455,11 @@ (map (lambda (keyval) ;; (conc ":" (car keyval) " " (cadr keyval))) (cadr keyval)) keydat) "/")) - (item-path (db:test-get-item-path testdat)) + (item-path (db:test-item-path testdat)) ;; this next block was added to fix a bug where variables were ;; needed. Revisit this. (runconfig (let ((runconfigf (conc *toppath* "/runconfigs.config"))) (if (file-exists? runconfigf) (handle-exceptions @@ -470,12 +470,12 @@ (testconfig (begin ;; (runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path) (runs:set-megatest-env-vars run-id inkeyvals: keydat inrunname: runname intarget: keystring testname: testname itempath: item-path) ;; these may be needed by the launching process (handle-exceptions exn - (tests:get-testconfig (db:test-get-testname testdat) test-registry #f) - (tests:get-testconfig (db:test-get-testname testdat) test-registry #t)))) + (tests:get-testconfig (db:test-testname testdat) test-registry #f) + (tests:get-testconfig (db:test-testname testdat) test-registry #t)))) (viewlog (lambda (x) (if (file-exists? logfile) ;(system (conc "firefox " logfile "&")) (dashboard-tests:run-html-viewer logfile) (message-window (conc "File " logfile " not found"))))) @@ -517,14 +517,14 @@ ;; (debug:print-info 0 "need-update= " need-update " curr-mod-time = " curr-mod-time) (cond ((and need-update newtestdat) (set! testdat newtestdat) (set! teststeps (tests:get-compressed-steps #f run-id test-id)) - (set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat))) + (set! logfile (conc (db:test-rundir testdat) "/" (db:test-final_logf testdat))) (set! rundir ;; (filedb:get-path *fdb* - (db:test-get-rundir testdat)) ;; ) - (set! testfullname (db:test-get-fullname testdat)) + (db:test-rundir testdat)) ;; ) + (set! testfullname (db:test-fullname testdat)) ;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n ")) ;; I don't see why this was implemented this way. Please comment it ... ;; (if (eq? curr-mod-time db-mod-time) ;; do only once if same ;; (set! db-mod-time (+ curr-mod-time 1)) @@ -534,11 +534,11 @@ (set! db-mod-time curr-mod-time)) (set! last-update (current-milliseconds)) (set! request-update #f) ;; met the need ... ) (need-update ;; if this was true and yet there is no data .... - (db:test-set-testname! testdat "DEAD OR DELETED TEST"))) + (db:test-testname-set! testdat "DEAD OR DELETED TEST"))) (if need-update (begin ;; update the gui elements here (for-each (lambda (key)