Megatest

Check-in [e03081d004]
Login
Overview
Comment:Added split for runs view.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: e03081d00456bcaa8966b47902178f5e93b35057
User & Date: mrwellan on 2016-08-25 10:59:28
Other Links: branch diff | manifest | tags
Context
2016-08-26
09:36
Merging trunk into v1.61 check-in: 61fbb64361 user: mrwellan tags: v1.61
2016-08-25
23:05
db.scm comments check-in: 44c895abc8 user: ritikaag tags: db
10:59
Added split for runs view. check-in: e03081d004 user: mrwellan tags: v1.61
2016-08-23
15:37
Run colors under run summary tab check-in: c2024aec0b user: ritikaag tags: v1.61
Changes

Modified dashboard.scm from [d50715d00e] to [9804b2cd5c].

1278
1279
1280
1281
1282
1283
1284
1285

1286
1287
1288
1289
1290
1291
1292
1278
1279
1280
1281
1282
1283
1284

1285
1286
1287
1288
1289
1290
1291
1292







-
+







				     "iup:canvas action")))
		       #:wheel-cb  (lambda (obj step x y dir) ;; dir is 4 for up and 5 for down. I think.
				     (debug:catch-and-dump
				      (lambda ()
					(let* ((drawing (dboard:tabdat-drawing tabdat))
					       (scalex  (vg:drawing-scalex drawing)))
					  (dboard:tabdat-view-changed-set! tabdat #t)
					  (print "step: " step " x: " x " y: " y " dir: " dir " scalex: " scalex)
					  ;; (print "step: " step " x: " x " y: " y " dir: " dir " scalex: " scalex)
					  (vg:drawing-scalex-set! drawing
								  (+ scalex
								     (if (> step 0)
									 (* scalex  0.02)
									 (* scalex -0.02))))))
				      "wheel-cb"))
		       )))
2038
2039
2040
2041
2042
2043
2044
2045

2046
2047
2048
2049
2050
2051
2052
2038
2039
2040
2041
2042
2043
2044

2045
2046
2047
2048
2049
2050
2051
2052







-
+







       (else
	(let ((labl  (iup:button "" ;; the testname labels
				 #:flat "YES" 
				 #:alignment "ALEFT"
					; #:image img1
					; #:impress img2
				 #:size  (conc cell-width btn-height)
				 #:expand  "NO" ;; "HORIZONTAL"
				 #:expand  "HORIZONTAL"
				 #:fontsize btn-fontsz
				 #:action (lambda (obj)
					    (mark-for-update runs-dat)
					    (toggle-hide testnum (dboard:commondat-uidat commondat)))))) ;; (iup:attribute obj "TITLE"))))
	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; These are the headers for each row
2126
2127
2128
2129
2130
2131
2132
2133
2134



2135
2136
2137
2138
2139





2140
2141
2142
2143
2144
2145
2146
2126
2127
2128
2129
2130
2131
2132


2133
2134
2135





2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147







-
-
+
+
+
-
-
-
-
-
+
+
+
+
+







      #:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*)
      #:menu (dcommon:main-menu)
      (let* ((runs-view (iup:vbox
			 (iup:split
			  #:orientation "VERTICAL" ;; "HORIZONTAL"
			  #:value 150
			  (dboard:runs-tree-browser commondat runs-dat)
			  (apply iup:hbox
				 (cons (apply iup:vbox lftlst)
			  (iup:split
			   ;; left most block, including row names
			   (apply iup:vbox lftlst)
				       (list 
					(iup:vbox
					 ;; the header
					 (apply iup:hbox (reverse hdrlst))
					 (apply iup:hbox (reverse bdylst)))))))
			   ;; right hand block, including cells
			   (iup:vbox
			    ;; the header
			    (apply iup:hbox (reverse hdrlst))
			    (apply iup:hbox (reverse bdylst)))))
			 controls
			 ))
	     ;; (data (dboard:tabdat-init (make-d:data)))
	     (tabs (iup:tabs
		    #:tabchangepos-cb (lambda (obj curr prev)
					(debug:catch-and-dump
					 (lambda ()

Modified runs.scm from [9c33432668] to [de4f2b1394].

941
942
943
944
945
946
947

948
949
950
951
952
953
954
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955







+







		    #f   ;; I think we are truly done here
		    (list (runs:queue-next-hed newtal reg reglen regfull)
			    (runs:queue-next-tal newtal reg reglen regfull)
			    (runs:queue-next-reg newtal reg reglen regfull)
			    reruns)))))))))

;; scan a list of tests looking to see if any are potentially runnable
;;
(define (runs:runable-tests tests)
  (filter (lambda (t)
	    (if (not (vector? t))
		t
		(let ((state  (db:test-get-state t))
		      (status (db:test-get-status t)))
		  (case (string->symbol state)