Megatest

Check-in [c9f0aef620]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Improved info page layout
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: c9f0aef620f38f4e99c9c8ca5cdeb3cd6cc333e2
User & Date: mrwellan on 2013-07-02 11:00:06
Other Links: branch diff | manifest | tags
Context
2013-07-02
16:28
Improved info page layout check-in: 0d67b603e1 user: mrwellan tags: dev
11:00
Improved info page layout check-in: c9f0aef620 user: mrwellan tags: dev
00:35
Oops, dropped new file check-in: 79e9017edb user: mrwellan tags: dev
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified dashboard.scm from [565f2bd4aa] to [ff610812c0].

︙︙
643
644
645
646
647
648
649


650
651
652



653







654
655
656
657
658
659
660
661

;; 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:hbox 
      (dcommon:general-info)
      (dcommon:keys-matrix rawconfig))



     (dcommon:section-matrix rawconfig "setup" "Varname" "Value")







     (dcommon:run-stats))))
   
;;======================================================================
;; R U N S 
;;======================================================================

(define (make-dashboard-buttons nruns ntests keynames)
  (let* ((nkeys   (length keynames))








>
>
|
|
|
>
>
>
|
>
>
>
>
>
>
>
|








643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673

;; 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:frame 
      #:title "General Info"
      (iup:hbox 
       (dcommon:general-info)
       (dcommon:keys-matrix rawconfig)))
     (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
	;; #:title "Disks Areas"
	(dcommon:section-matrix rawconfig "disks" "Disk area" "Path"))))
     (iup:frame
      #:title "Run statistics"
      (dcommon:run-stats)))))
   
;;======================================================================
;; R U N S 
;;======================================================================

(define (make-dashboard-buttons nruns ntests keynames)
  (let* ((nkeys   (length keynames))
︙︙

Modified db.scm from [15ecc35fb6] to [572d71d91a].

︙︙
680
681
682
683
684
685
686

687
688
689

690
691
692



693
694
695
696
697
698
699

    numruns))

;; get some basic run stats
;;
;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats db)

  (let ((res          '()))
    (sqlite3:for-each-row
     (lambda (runname state count)

       (set! res (cons (list runname state count) res)))
     db
     "SELECT runname,t.state,count(t.id) FROM runs AS r INNER JOIN tests AS t ON r.id=t.run_id GROUP BY t.state,runname;" )



    res))

;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo))








>
|


>


|
>
>
>








680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704

    numruns))

;; get some basic run stats
;;
;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats db)
  (let ((totals       (make-hash-table))
	(res          '()))
    (sqlite3:for-each-row
     (lambda (runname state count)
       (hash-table-set! totals state (+ (hash-table-ref/default totals state 0) count))
       (set! res (cons (list runname state count) res)))
     db
    "SELECT runname,t.state||'/'||t.status AS s,count(t.id) FROM runs AS r INNER JOIN tests AS t ON r.id=t.run_id GROUP BY s,runname;" )
    (for-each (lambda (state)
		(set! res (cons (list "Totals" state (hash-table-ref totals state)) res)))
	      (hash-table-keys totals))
    res))

;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
︙︙

Modified dcommon.scm from [7faf98a5d2] to [edf30f9368].

︙︙
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50


;; Table of keys
(define (dcommon:keys-matrix rawconfig)
  (let* ((curr-row-num 1)
	 (key-vals     (configf:section-vars rawconfig "fields"))
	 (keys-matrix  (iup:matrix
			#:alignment1 "ALEFT"
			#:expand "HORIZONTAL" ;; "VERTICAL"
			;; #:scrollbar "YES"
			#:numcol 1
			#:numlin (length key-vals)
			#:numcol-visible 1
			#:numlin-visible 5
			#: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 "0:1" "Key Name")
    (iup:attribute-set! keys-matrix "WIDTH1" "100")
    ;; fill in keys
    (for-each 








|




|








31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50


;; Table of keys
(define (dcommon:keys-matrix rawconfig)
  (let* ((curr-row-num 1)
	 (key-vals     (configf:section-vars rawconfig "fields"))
	 (keys-matrix  (iup:matrix
			#:alignment1 "ALEFT"
			#:expand "YES" ;; "HORIZONTAL" ;; "VERTICAL"
			;; #: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 "0:1" "Key Name")
    (iup:attribute-set! keys-matrix "WIDTH1" "100")
    ;; fill in keys
    (for-each
︙︙
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100


;; 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
			   #:alignment1 "ALEFT"
			   #:expand "HORIZONTAL" ;; "YES"
			   #:numcol 1
			   #:numlin (length key-vals)
			   #:numcol-visible 1
			   #:numlin-visible 5
			   #:scrollbar "YES")))
    (iup:attribute-set! section-matrix "0:0" varcolname)
    (iup:attribute-set! section-matrix "0:1" valcolname)
    (iup:attribute-set! section-matrix "WIDTH1" "300")
    ;; fill in keys
    (for-each 
     (lambda (var)
       ;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
       (iup:attribute-set! section-matrix (conc curr-row-num ":0") var)
       (iup:attribute-set! section-matrix (conc curr-row-num ":1") (configf:lookup rawconfig sectionname var))
       (set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
     key-vals)
    (iup:vbox
     (iup:label (if title title (conc "Settings from [" sectionname "]"))  
		#:size   "5x"
		#:expand "HORIZONTAL")

     section-matrix)))
    
;; General data
;;
(define (dcommon:general-info)
  (let ((general-matrix (iup:matrix
			 #:alignment1 "ALEFT"
			 #:expand "HORIZONTAL" ;; "YES"
			 #:numcol 1
			 #:numlin 3
			 #:numcol-visible 1
			 #:numlin-visible 3)))
    (iup:attribute-set! general-matrix "WIDTH1" "300")
    (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








|



|















|
>







|








58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101


;; 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
			   #:alignment1 "ALEFT"
			   #:expand "YES" ;; "HORIZONTAL"
			   #:numcol 1
			   #:numlin (length key-vals)
			   #:numcol-visible 1
			   #:numlin-visible (length key-vals)
			   #:scrollbar "YES")))
    (iup:attribute-set! section-matrix "0:0" varcolname)
    (iup:attribute-set! section-matrix "0:1" valcolname)
    (iup:attribute-set! section-matrix "WIDTH1" "300")
    ;; fill in keys
    (for-each 
     (lambda (var)
       ;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
       (iup:attribute-set! section-matrix (conc curr-row-num ":0") var)
       (iup:attribute-set! section-matrix (conc curr-row-num ":1") (configf:lookup rawconfig sectionname var))
       (set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
     key-vals)
    (iup:vbox
     (iup:label (if title title (conc "Settings from [" sectionname "]"))  
		#:size   "5x"
		#:expand "HORIZONTAL"
		)
     section-matrix)))
    
;; General data
;;
(define (dcommon:general-info)
  (let ((general-matrix (iup:matrix
			 #:alignment1 "ALEFT"
			 #:expand "YES" ;; "HORIZONTAL"
			 #:numcol 1
			 #:numlin 3
			 #:numcol-visible 1
			 #:numlin-visible 3)))
    (iup:attribute-set! general-matrix "WIDTH1" "300")
    (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
︙︙
109
110
111
112
113
114
115

116
117
118
119
120
121
122
123
124
125
126
127
128
129

    general-matrix))

(define (dcommon:run-stats)
  (let* ((run-stats    (mt:get-run-stats))
	 (indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
	 (max-row      (apply max (map cadr (car indices))))
	 (max-col      (apply max (map cadr (cadr indices))))

	 (stats-matrix (iup:matrix
			#:alignment1 "ALEFT"
			#:expand "HORIZONTAL"
			#:numcol max-col 
			#:numlin (if (< max-row 20) 20 max-row) ;; min of 20
			#:numcol-visible max-col
			#:numlin-visible (if (> max-row 20) 20 max-row)))
	 (numrows      1)
	 (numcols      1)
	 (set-cell     (lambda (rnum cnum rname cname v) ;; rownum colnum value
			 (print "proc called: " rnum " " cnum " " rname " " cname " " v)
			 (if (> rnum numrows)
			     (begin 
			       ;; add rows numrows to r








>


|

|

|








110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

    general-matrix))

(define (dcommon:run-stats)
  (let* ((run-stats    (mt:get-run-stats))
	 (indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
	 (max-row      (apply max (map cadr (car indices))))
	 (max-col      (apply max (map cadr (cadr indices))))
	 (max-visible  (max (- *num-tests* 15) 3))
	 (stats-matrix (iup:matrix
			#:alignment1 "ALEFT"
			#:expand "YES" ;; "HORIZONTAL"
			#:numcol max-col 
			#:numlin (if (< max-row max-visible) max-visible max-row) ;; min of 20
			#:numcol-visible max-col
			#:numlin-visible (if (> max-row max-visible) max-visible max-row)))
	 (numrows      1)
	 (numcols      1)
	 (set-cell     (lambda (rnum cnum rname cname v) ;; rownum colnum value
			 (print "proc called: " rnum " " cnum " " rname " " cname " " v)
			 (if (> rnum numrows)
			     (begin 
			       ;; add rows numrows to r
︙︙

This page was generated in about 0.112s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00