Overview
Comment: | v1.81-test-control-panel branch into 1.81 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.81 |
Files: | files | file ages | folders |
SHA1: |
a6b2094831bd0c5af7b9da5f24f56bb7 |
User & Date: | ramartin on 2024-07-01 16:57:20 |
Other Links: | branch diff | manifest | tags |
Context
2024-07-01
| ||
17:27 | Changed version to v1.8101 check-in: 6b8bacba76 user: mmgraham tags: v1.81, v1.8101 | |
16:57 | v1.81-test-control-panel branch into 1.81 check-in: a6b2094831 user: ramartin tags: v1.81 | |
11:59 | Added CSCOPTS entry used for debugging check-in: 74949ef691 user: mrwellan tags: v1.81 | |
10:56 | Pulled in testcontrol panel improvements Leaf check-in: f8243ad180 user: mrwellan tags: v1.81-test-control-panel | |
Changes
Modified dashboard-tests.scm from [ceec46e3cb] to [9ace3eb7d8].
︙ | ︙ | |||
93 94 95 96 97 98 99 | (list "Testname: " "Item path: " "Current state: " "Current status: " "Test comment: " "Test id: " "Test date: ")) | | > | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 | (list "Testname: " "Item path: " "Current state: " "Current status: " "Test comment: " "Test id: " "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))) (store-label "item-path" (iup:label (db:test-get-item-path testdat) #:expand "HORIZONTAL") |
︙ | ︙ | |||
161 162 163 164 165 166 167 | (iup:label val ; #:expand "HORIZONTAL" )) (list "Author: " "Owner: " "Reviewed: " "Tags: " "Description: ")) | | > | > | 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 | (iup:label val ; #:expand "HORIZONTAL" )) (list "Author: " "Owner: " "Reviewed: " "Tags: " "Description: ")) (list (iup:label "" #:expand "VERTICAL" )))) (apply iup:vbox ; #:expand "YES" (list (store-meta "author" (iup:label (db:testmeta-get-author testmeta) #:expand "HORIZONTAL") (lambda (testmeta)(db:testmeta-get-author testmeta))) (store-meta "owner" (iup:label (db:testmeta-get-owner testmeta) #:expand "HORIZONTAL") (lambda (testmeta)(db:testmeta-get-owner testmeta))) (store-meta "reviewed" (iup:label (db:testmeta-get-reviewed testmeta) #:expand "HORIZONTAL") (lambda (testmeta)(db:testmeta-get-reviewed testmeta))) (store-meta "tags" (iup:label (db:testmeta-get-tags testmeta) #:expand "HORIZONTAL") (lambda (testmeta)(db:testmeta-get-tags testmeta))) (store-meta "description" (iup:label (test-meta-panel-get-description testmeta) ;; #:wordwrap "YES" ;; #:size "x50" ) ;; #:expand "HORIZONTAL") (lambda (testmeta) (test-meta-panel-get-description testmeta))) ))))) ;;====================================================================== ;; Run info panel |
︙ | ︙ | |||
205 206 207 208 209 210 211 | (iup:label (conc (car keyval) " "))) keydat) (list (iup:label "runname ") (iup:label "run-id") (iup:label "run-date")))) (apply iup:vbox (append (map (lambda (keyval) | > | > > > | > | > | 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 | (iup:label (conc (car keyval) " "))) keydat) (list (iup:label "runname ") (iup:label "run-id") (iup:label "run-date")))) (apply iup:vbox (append (map (lambda (keyval) (iup:vbox (iup:label (cadr keyval) #:expand "HORIZONTAL") ;; (iup:label "" #:expand "BOTH") ) ) keydat) (list (iup:label runname) (iup:label (conc run-id)) (iup:label (seconds->year-work-week/day-time event_time)) (iup:label "" ;;#:expand "VERTICAL" )))))))) ;;====================================================================== ;; Host info panel ;;====================================================================== (define (host-info-panel testdat store-label) (iup:frame #:title "Remote host and Test Run Info" ; #:expand "YES" (iup:hbox ; #:expand "YES" (apply iup:vbox ; #:expand "YES" ;; The heading labels (append (map (lambda (val) (iup:label val ; #:expand "HORIZONTAL" )) (list "Hostname: " "Disk free: " "CPU Load: " "Run duration: " "Logfile: " "Top process id: " "Uname -a: ")) (iup:label "" ;; #:expand "VERTICAL" ))) (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) ;; ) #:expand "HORIZONTAL") |
︙ | ︙ | |||
266 267 268 269 270 271 272 | ;; if there is a submegatest create a button to launch dashboard in that area ;; (define (submegatest-panel dbstruct keydat testdat runname testconfig) (let* ((test-run-dir (db:test-get-rundir testdat)) (subarea (subrun:get-runarea test-run-dir)) (area-exists (and subarea (common:file-exists? subarea silent: #t)))) | < | | > | | > > | 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 | ;; if there is a submegatest create a button to launch dashboard in that area ;; (define (submegatest-panel dbstruct keydat testdat runname testconfig) (let* ((test-run-dir (db:test-get-rundir testdat)) (subarea (subrun:get-runarea test-run-dir)) (area-exists (and subarea (common:file-exists? subarea silent: #t)))) (iup:frame #:title "Megatest Run Info" ;; #:expand "HORIZONTAL" (if subarea (iup:button "Launch Dashboard" #:action (lambda (obj) (subrun:launch-dashboard test-run-dir))) (iup:vbox (iup:label "Not a subrun..." #:expand "HORIZONTAL") ))))) ;; 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)) |
︙ | ︙ | |||
669 670 671 672 673 674 675 676 677 678 679 680 681 682 | (iup:attribute-set! command-text-box "VALUE" (conc "megatest -target " keystring " -runname " runname " -run -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) " -clean-cache" )))) (remove-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -remove-runs -target " keystring " -runname " runname " -testpatt " (conc testname "/" (if (equal? item-path "") "%" | > > > > > > > > > | 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 | (iup:attribute-set! command-text-box "VALUE" (conc "megatest -target " keystring " -runname " runname " -run -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) " -clean-cache" )))) (rerun-clean (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -target " keystring " -runname " runname " -rerun-clean -testpatt " (conc testname "/" (if (equal? item-path "") "%" item-path)) " -clean-cache" )))) (remove-test (lambda (x) (iup:attribute-set! command-text-box "VALUE" (conc "megatest -remove-runs -target " keystring " -runname " runname " -testpatt " (conc testname "/" (if (equal? item-path "") "%" |
︙ | ︙ | |||
717 718 719 720 721 722 723 | ((not testdat)(begin (debug:print 0 *default-log-port* "ERROR: bad test info for " test-id)(exit 1))) ((not rundat)(begin (debug:print 0 *default-log-port* "ERROR: found test info but there is a problem with the run info for " run-id)(exit 1))) (else ;; (test-set-status! db run-id test-name state status itemdat) (set! self ; (iup:dialog #:close_cb (lambda (a)(exit)) ; #:expand "YES" #:title testfullname | > > | | | | | | | | | | | | > > | > > > > > | > | < | > > > > | | > | 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 | ((not testdat)(begin (debug:print 0 *default-log-port* "ERROR: bad test info for " test-id)(exit 1))) ((not rundat)(begin (debug:print 0 *default-log-port* "ERROR: found test info but there is a problem with the run info for " run-id)(exit 1))) (else ;; (test-set-status! db run-id test-name state status itemdat) (set! self ; (iup:dialog #:close_cb (lambda (a)(exit)) ; #:expand "YES" #:title testfullname (iup:vbox (iup:hbox (iup:vbox ; #:expand "YES" ;; The run and test info (iup:hbox ; #:expand "YES" (run-info-panel dbstruct keydat testdat runname) (test-info-panel testdat store-label widgets)) (host-info-panel testdat store-label)) (iup:vbox (test-meta-panel testmeta store-meta) (submegatest-panel dbstruct keydat testdat runname testconfig))) ;; The controls (iup:hbox ;; frame #:title "Actions" (iup:vbox (iup:hbox (iup:frame #:title "Immediate" (iup:hbox (iup:button "Start Xterm" #:action xterm #:size "80x") (iup:button "CleanRunExecute!" #:action clean-run-execute #:size "80x") (iup:button "View Log" #:action viewlog #:size "80x"))) (iup:frame #:title "Command line" (iup:hbox (iup:button "Run Test" #:action run-test #:size "80x") (iup:button "Rerun-clean" #:action rerun-clean #:size "80x") (iup:button "Clean Test" #:action remove-test #:size "80x") (iup:button "Kill All Jobs" #:action kill-jobs #:size "80x"))) (iup:label "" #:expand "HORIZONTAL") (iup:frame #:title "Other" (iup:hbox ;; (iup:button "Archive Test" #:action archive-test #:size "80x") (iup:button "Close" #:action (lambda (x)(exit)) #:size "80x") ))) (apply iup:hbox (list command-text-box command-launch-button)))) (set-fields-panel dbstruct run-id test-id testdat) (let ((tabs (iup:tabs ;; Replace here with matrix |
︙ | ︙ |