Overview
| Comment: | Primitive server controls added. Fixed max and sort for view in Runs Summary mode |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | dev |
| Files: | files | file ages | folders |
| SHA1: |
d280b3b369169a356606cb24f0aa3506 |
| User & Date: | mrwellan on 2013-07-10 17:16:25 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-07-10
| ||
| 18:15 | Added MT_TARGET to testconfig environment. Added first four chars of fossil node hash to version in server registry. check-in: d604df857c user: mrwellan tags: dev | |
| 17:16 | Primitive server controls added. Fixed max and sort for view in Runs Summary mode check-in: d280b3b369 user: mrwellan tags: dev | |
|
2013-07-08
| ||
| 15:34 | viewing of log files from clicking in steps fixed check-in: c69460d617 user: mrwellan tags: dev | |
Changes
Modified common.scm from [fa9ef8f681] to [8a39966f54].
| ︙ | ︙ | |||
168 169 170 171 172 173 174 175 176 177 178 179 180 181 | (if (null? tala) ;; we are done talb (loop (car tala) (cdr tala) (car talb) (cdr talb))) #f))))) ;;====================================================================== ;; Munge data into nice forms ;;====================================================================== ;; Generate an index for a sparse list of key values ;; ( (rowname1 colname1 val1)(rowname2 colname2 val2) ) | > > > > > > > > > > > > > | 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 |
(if (null? tala) ;; we are done
talb
(loop (car tala)
(cdr tala)
(car talb)
(cdr talb)))
#f)))))
;; Needed for long lists to be sorted where (apply max ... ) dies
;;
(define (common:max inlst)
(let loop ((max-val (car inlst))
(hed (car inlst))
(tal (cdr inlst)))
(if (null? tal)
(loop (max hed max-val)
(car tal)
(cdr tal))
(max hed max-val))))
;;======================================================================
;; Munge data into nice forms
;;======================================================================
;; Generate an index for a sparse list of key values
;; ( (rowname1 colname1 val1)(rowname2 colname2 val2) )
|
| ︙ | ︙ |
Modified dashboard.scm from [3c2896b4ca] to [7594703fba].
| ︙ | ︙ | |||
873 874 875 876 877 878 879 |
;; S U M M A R Y
;;======================================================================
;;
;; General info about the run(s) and megatest area
(define (dashboard:summary)
(let ((rawconfig (read-config (conc *toppath* "/megatest.config") #f 'return-string)))
(iup:vbox
| > > | | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > | | 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 |
;; S U M M A R Y
;;======================================================================
;;
;; General info about the run(s) and megatest area
(define (dashboard:summary)
(let ((rawconfig (read-config (conc *toppath* "/megatest.config") #f 'return-string)))
(iup:vbox
(iup:split
;; #:value 500
(iup:frame
#:title "General Info"
(iup:hbox
(dcommon:keys-matrix rawconfig)
(dcommon:general-info)
))
(iup:frame
#:title "Server"
(iup:vbox
(iup:hbox
(iup:button "Start"
#:size "50x"
#:action (lambda (obj)
(let ((cmd (conc "xterm -geometry 180x20 -e \""
"megatest -server -"
";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
(system cmd))))
(iup:button "Stop"
#:size "50x"
#:action (lambda (obj)
(let ((cmd (conc "xterm -geometry 180x20 -e \""
"megatest -stop-server 0"
";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
(system cmd))))
(iup:button "Restart"
#:size "50x"
#:action (lambda (obj)
(let ((cmd (conc "xterm -geometry 180x20 -e \""
"megatest -stop-server 0;megatest -server -"
";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
(system cmd))))
))))
(iup:frame
#:title "Megatest config settings"
(iup:hbox
(dcommon:section-matrix rawconfig "setup" "Varname" "Value")
(iup:vbox
(dcommon:section-matrix rawconfig "server" "Varname" "Value")
;; (iup:frame
|
| ︙ | ︙ | |||
930 931 932 933 934 935 936 | (updater (lambda () (let* ((runs-dat (mt:get-runs-by-patt *keys* "%" #f)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (run-id (dboard:data-get-curr-run-id *data*)) (tests-dat (let ((tdat (mt:get-tests-for-run run-id "%" '() '() qryvals: "id,testname,item_path,state,status"))) ;; get 'em all (sort tdat (lambda (a b) | | > > > > > > | | | 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 | (updater (lambda () (let* ((runs-dat (mt:get-runs-by-patt *keys* "%" #f)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (run-id (dboard:data-get-curr-run-id *data*)) (tests-dat (let ((tdat (mt:get-tests-for-run run-id "%" '() '() qryvals: "id,testname,item_path,state,status"))) ;; get 'em all (sort tdat (lambda (a b) (let* ((aval (vector-ref a 2)) (bval (vector-ref b 2)) (anum (string->number aval)) (bnum (string->number bval))) (if (and anum bnum) (< anum bnum) (string<= aval bval))))))) (tests-mindat (dcommon:minimize-test-data tests-dat)) (indices (common:sparse-list-generate-index tests-mindat)) ;; proc: set-cell)) (row-indices (cadr indices)) (col-indices (car indices)) (max-row (if (null? row-indices) 1 (common:max (map cadr row-indices)))) (max-col (if (null? col-indices) 1 (common:max (map cadr col-indices)))) (max-visible (max (- *num-tests* 15) 3)) ;; *num-tests* is proportional to the size of the window (numrows 1) (numcols 1) (changed #f) (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) |
| ︙ | ︙ |
Modified dcommon.scm from [e7f13a8aa3] to [d64064e1b4].
| ︙ | ︙ | |||
303 304 305 306 307 308 309 | ;; #:scrollbar "YES" #:numcol 1 #:numlin (length key-vals) #:numcol-visible 1 #:numlin-visible (length key-vals) #:click-cb (lambda (obj lin col status) (print "obj: " obj " lin: " lin " col: " col " status: " status))))) | | > > | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 |
;; #:scrollbar "YES"
#:numcol 1
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible (length key-vals)
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
;; (iup:attribute-set! keys-matrix "0:0" "Run Keys")
(iup:attribute-set! keys-matrix "WIDTH0" 0)
(iup:attribute-set! keys-matrix "0:1" "Key Name")
;; (iup:attribute-set! keys-matrix "WIDTH1" "100")
;; fill in keys
(for-each
(lambda (var)
;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
(iup:attribute-set! keys-matrix (conc curr-row-num ":0") curr-row-num)
(iup:attribute-set! keys-matrix (conc curr-row-num ":1") var)
(set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
key-vals)
(iup:attribute-set! keys-matrix "WIDTHDEF" "40")
keys-matrix))
;; Section to table
(define (dcommon:section-matrix rawconfig sectionname varcolname valcolname #!key (title #f))
(let* ((curr-row-num 1)
(key-vals (configf:section-vars rawconfig sectionname))
(section-matrix (iup:matrix
|
| ︙ | ︙ | |||
362 363 364 365 366 367 368 |
#:numlin-visible 3)))
(iup:attribute-set! general-matrix "WIDTH1" "200")
(iup:attribute-set! general-matrix "0:1" "About this Megatest area")
;; User (this is not always obvious - it is common to run as a different user
(iup:attribute-set! general-matrix "1:0" "User")
(iup:attribute-set! general-matrix "1:1" (current-user-name))
;; Megatest area
| | | > | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 |
#:numlin-visible 3)))
(iup:attribute-set! general-matrix "WIDTH1" "200")
(iup:attribute-set! general-matrix "0:1" "About this Megatest area")
;; User (this is not always obvious - it is common to run as a different user
(iup:attribute-set! general-matrix "1:0" "User")
(iup:attribute-set! general-matrix "1:1" (current-user-name))
;; Megatest area
(iup:attribute-set! general-matrix "2:0" "Area")
(iup:attribute-set! general-matrix "2:1" *toppath*)
;; Megatest version
(iup:attribute-set! general-matrix "3:0" "Version")
(iup:attribute-set! general-matrix "3:1" megatest-version)
general-matrix))
(define (dcommon:run-stats)
(let* ((stats-matrix (iup:matrix expand: "YES"))
(changed #f)
(updater (lambda ()
(let* ((run-stats (mt:get-run-stats))
|
| ︙ | ︙ |