Megatest
Check-in [9baa06c1ce]
Not logged in
Overview
SHA1:9baa06c1cec200bb1c82d39952a139bb64225ccd
Date: 2011-10-26 13:42:16
User: mrwellan
Comment:Added back the hiding of empty runs
Timelines: family | ancestors | guitweaks
Downloads: Tarball | ZIP archive
Other Links: files | file ages | folders | manifest
Tags And Properties
Context
2011-10-26
14:03
[bb8b14dea5] Merged guitweaks (includes stuff from private branches (user: mrwellan, tags: trunk)
13:42
[9baa06c1ce] Closed-Leaf: Added back the hiding of empty runs (user: mrwellan, tags: guitweaks)
10:59
[d25299ae49] Cleaned up the left labels, got some semblence of sorting to work (user: mrwellan, tags: guitweaks)
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified dashboard.scm from [bc8cfd9064] to [f724b05dae].

100
101
102
103
104
105
106

107
108
109
110
111
112
113
...
218
219
220
221
222
223
224

225
226
227
228
229
230
231
232
233
...
358
359
360
361
362
363
364


365
366
367
368
369
370
371
372
373
374
375
376
...
473
474
475
476
477
478
479
480




481
482
483
484
485
486
487
(define *state-ignore-hash*  (make-hash-table))

(define *last-db-update-time* 0)
(define *please-update-buttons* #t)
(define *db-file-path* (conc *toppath* "/megatest.db"))

(define *tests-sort-reverse* #f)


(define *verbosity* (cond
		     ((args:get-arg "-debug")(string->number (args:get-arg "-debug")))
		     ((args:get-arg "-v")    2)
		     ((args:get-arg "-q")    0)
		     (else                   1)))

................................................................................
	    (for-each (lambda (run)
			(let* ((run-id   (db:get-value-by-header run header "id"))
			       (tests    (let ((tsts (db-get-tests-for-run *db* run-id testnamepatt itemnamepatt states statuses)))
					   (if *tests-sort-reverse* (reverse tsts) tsts)))
			       (key-vals (get-key-vals *db* run-id)))
			  (if (> (length tests) maxtests)
			      (set! maxtests (length tests)))

			  ;(if (not (null? tests))
			      (set! result (cons (vector run tests key-vals) result)))); )
		      runs)
	    (set! *header*  header)
	    (set! *allruns* result)
	    (debug:print 6 "*allruns* has " (length *allruns*) " runs")
	    ;; (set! *tot-run-count* (+ 1 (length *allruns*)))
	    maxtests))
	*num-tests*))) ;; FIXME, naughty coding eh?
................................................................................
	(set! *alltestnamelst* '())
	;; create a concise list of test names
	(for-each
	 (lambda (rundat)
	   (if (vector? rundat)
	       (let* ((testdat   (vector-ref rundat 1))
		      (testnames (map test:test-get-fullname testdat)))


		 (for-each (lambda (testname)
			     (if (not (member testname *alltestnamelst*))
				 (begin
				   (set! *alltestnamelst* (append *alltestnamelst* (list testname))))))
			   testnames))))
	 runs)

	(set! *alltestnamelst* (collapse-rows *alltestnamelst*)) ;;; argh. please clean up this sillyness
	(set! *alltestnamelst* (let ((xl (if (> (length *alltestnamelst*) *start-test-offset*)
					     (drop *alltestnamelst* *start-test-offset*)
					     '())))
				 (append xl (make-list (- *num-tests* (length xl)) ""))))
................................................................................
				      (set! *last-db-update-time* 0)
				      (update-search "item-name" val)))))
	    (iup:vbox
	     (iup:hbox
	      (iup:button "Sort" #:action (lambda (obj)
					    (set! *tests-sort-reverse* (not *tests-sort-reverse*))
					    (iup:attribute-set! obj "TITLE" (if *tests-sort-reverse* "+Sort" "-Sort"))
					    (set! *last-db-update-time* 0))))




	     (iup:hbox
	      (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
	      (iup:button "Monitor" #:action (lambda (obj)(system (conc (car (argv))" -guimonitor &")))))
	     ))
	   ;; (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
	   ;; (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
	   ;; (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))







>







 







>
|
|







 







>
>
|
|
|
|
|







 







|
>
>
>
>







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
...
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
...
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
...
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
(define *state-ignore-hash*  (make-hash-table))

(define *last-db-update-time* 0)
(define *please-update-buttons* #t)
(define *db-file-path* (conc *toppath* "/megatest.db"))

(define *tests-sort-reverse* #f)
(define *hide-empty-runs* #f)

(define *verbosity* (cond
		     ((args:get-arg "-debug")(string->number (args:get-arg "-debug")))
		     ((args:get-arg "-v")    2)
		     ((args:get-arg "-q")    0)
		     (else                   1)))

................................................................................
	    (for-each (lambda (run)
			(let* ((run-id   (db:get-value-by-header run header "id"))
			       (tests    (let ((tsts (db-get-tests-for-run *db* run-id testnamepatt itemnamepatt states statuses)))
					   (if *tests-sort-reverse* (reverse tsts) tsts)))
			       (key-vals (get-key-vals *db* run-id)))
			  (if (> (length tests) maxtests)
			      (set! maxtests (length tests)))
			  (if (or (not *hide-empty-runs*) ;; this reduces the data burden when set
				  (not (null? tests)))
			      (set! result (cons (vector run tests key-vals) result)))))
		      runs)
	    (set! *header*  header)
	    (set! *allruns* result)
	    (debug:print 6 "*allruns* has " (length *allruns*) " runs")
	    ;; (set! *tot-run-count* (+ 1 (length *allruns*)))
	    maxtests))
	*num-tests*))) ;; FIXME, naughty coding eh?
................................................................................
	(set! *alltestnamelst* '())
	;; create a concise list of test names
	(for-each
	 (lambda (rundat)
	   (if (vector? rundat)
	       (let* ((testdat   (vector-ref rundat 1))
		      (testnames (map test:test-get-fullname testdat)))
		 (if (not (and *hide-empty-runs*
			       (null? testnames)))
		     (for-each (lambda (testname)
				 (if (not (member testname *alltestnamelst*))
				     (begin
				       (set! *alltestnamelst* (append *alltestnamelst* (list testname))))))
			       testnames)))))
	 runs)

	(set! *alltestnamelst* (collapse-rows *alltestnamelst*)) ;;; argh. please clean up this sillyness
	(set! *alltestnamelst* (let ((xl (if (> (length *alltestnamelst*) *start-test-offset*)
					     (drop *alltestnamelst* *start-test-offset*)
					     '())))
				 (append xl (make-list (- *num-tests* (length xl)) ""))))
................................................................................
				      (set! *last-db-update-time* 0)
				      (update-search "item-name" val)))))
	    (iup:vbox
	     (iup:hbox
	      (iup:button "Sort" #:action (lambda (obj)
					    (set! *tests-sort-reverse* (not *tests-sort-reverse*))
					    (iup:attribute-set! obj "TITLE" (if *tests-sort-reverse* "+Sort" "-Sort"))
					    (set! *last-db-update-time* 0)))
	      (iup:button "HideEmpty" #:action (lambda (obj)
						 (set! *hide-empty-runs* (not *hide-empty-runs*))
						 (iup:attribute-set! obj "TITLE" (if *hide-empty-runs* "+Hide" "-Hide"))
						 (set! *last-db-update-time* 0))))
	     (iup:hbox
	      (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
	      (iup:button "Monitor" #:action (lambda (obj)(system (conc (car (argv))" -guimonitor &")))))
	     ))
	   ;; (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
	   ;; (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
	   ;; (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))