Megatest

Check-in [ef4bccf3fa]
Login
Overview
Comment:Fixed dashboard scrolling induced crash
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | experimental
Files: files | file ages | folders
SHA1: ef4bccf3fa5cc5783c08ca31a496b45d42b7540a
User & Date: mrwellan on 2011-06-22 23:44:29
Other Links: branch diff | manifest | tags
Context
2011-06-25
17:44
Start refactoring dashboard check-in: 101b0b8206 user: mrwellan tags: refactor-dashboard
17:41
Create new branch named "refactor-dashboard" check-in: 5a744af62c user: mrwellan tags: refactor-dashboard
2011-06-22
23:44
Fixed dashboard scrolling induced crash Closed-Leaf check-in: ef4bccf3fa user: mrwellan tags: experimental
23:14
Added checking for exceeding max runs to the run-later queue check-in: e953469a27 user: mrwellan tags: experimental
Changes

Modified dashboard.scm from [f9bbef1e8d] to [58f9720af4].

250
251
252
253
254
255
256

257


258
259
260
261
262
263
264
250
251
252
253
254
255
256
257

258
259
260
261
262
263
264
265
266







+
-
+
+







      (if (< i maxn)
	  (loop (+ i 1))))
    (for-each (lambda (name)
		(if (<= rown maxn)
		    (let ((labl (vector-ref lftcol rown)))
		      (iup:attribute-set! labl "TITLE" name)))
		(set! rown (+ 1 rown)))
	      (if (> (length *alltestnamelst*) *start-test-offset*)
	      (drop *alltestnamelst* *start-test-offset*))))
		  (drop *alltestnamelst* *start-test-offset*)
		  '())))) ;; *alltestnamelst*))))

(define (update-buttons uidat numruns numtests)
  (let* ((runs        (if (> (length *allruns*) numruns)
			  (take-right *allruns* numruns)
			  (pad-list *allruns* numruns)))
	 (lftcol      (vector-ref uidat 0))
	 (tableheader (vector-ref uidat 1))
373
374
375
376
377
378
379
380

381
382
383
384
385
386
387
375
376
377
378
379
380
381

382
383
384
385
386
387
388
389







-
+







			  (begin
			    (hash-table-set! *alltestnames* testfullname #t)
			    (set! *alltestnamelst* (append *alltestnamelst* (list testfullname))))))
		    )
		(set! rown (+ rown 1))))
	    (let ((xl (if (> (length testnames) *start-test-offset*)
			  (drop testnames *start-test-offset*)
			  testnames)))
			  '()))) ;; testnames)))
	      (append xl (make-list (- *num-tests* (length xl)) "")))))
	 (set! coln (+ coln 1))))
     runs)))

(define (mkstr . x)
  (string-intersperse (map conc x) ","))