Megatest

Check-in [66a0b5821b]
Login
Overview
Comment:Fixed fallout from refactoring
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: 66a0b5821be17025b4da9941ebb346c35507ce19
User & Date: mrwellan on 2016-07-22 16:34:59
Other Links: branch diff | manifest | tags
Context
2016-07-22
17:57
more incremental draw check-in: 4d158f878f user: mrwellan tags: v1.61
16:34
Fixed fallout from refactoring check-in: 66a0b5821b user: mrwellan tags: v1.61
15:09
Added hash of fulltestname => testdat check-in: 082dea7a8d user: mrwellan tags: v1.61
Changes

Modified dashboard.scm from [f3f796ec5e] to [1d8470c8da].

1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116







1117
1118
1119
1120
1121
1122
1123
1104
1105
1106
1107
1108
1109
1110






1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124







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







;; R U N   C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
(define (dashboard:run-times commondat tabdat #!key (tab-num #f))
  (let ((drawing               (vg:drawing-new))
	(run-times-tab-updater (debug:catch-and-dump 
				(lambda ()	
				  (let ((tabdat        (dboard:common-get-tabdat commondat tab-num: tab-num)))
				    (if tabdat
					(dashboard:run-times-tab-updater commondat tabdat tab-num))))
				"dashboard:run-times-tab-updater")))
	(run-times-tab-updater (lambda ()	
				 (debug:catch-and-dump 
				  (lambda ()
				    (let ((tabdat        (dboard:common-get-tabdat commondat tab-num: tab-num)))
				      (if tabdat
					  (dashboard:run-times-tab-updater commondat tabdat tab-num))))
				  "dashboard:run-times-tab-updater"))))
    (dboard:tabdat-drawing-set! tabdat drawing)
    (dboard:commondat-add-updater commondat run-times-tab-updater tab-num: tab-num)
    (iup:split
     #:orientation "VERTICAL" ;; "HORIZONTAL"
     #:value 200
     (let* ((tb      (iup:treebox
		      #:value 0
2356
2357
2358
2359
2360
2361
2362


2363
2364
2365
2366
2367
2368
2369
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372







+
+







  (if (null? lst)
      #f ;; better than an exception for my needs
      (fold (lambda (a b)
	      (if (comp a b) a b))
	    (car lst)
	    lst)))

;; sort a list of test-ids by the event _time using a hash table of id => testdat
;;
(define-inline (dboard:sort-testsdat-by-event-time test-ids tests-ht)
  (sort test-ids
	(lambda (a b)
	  (< (db:test-get-event_time (hash-table-ref tests-ht a))
	     (db:test-get-event_time (hash-table-ref tests-ht b))))))

;; first group items into lists, then sort by time
2394
2395
2396
2397
2398
2399
2400
2401

2402
2403
2404

2405
2406
2407
2408
2409
2410
2411
2397
2398
2399
2400
2401
2402
2403

2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415







-
+



+







	   (let ((tests-id-lst (hash-table-ref test-ids-by-name testname)))
	     (if (> (length tests-id-lst) 1) ;; must be iterated
		 (let ((item-tests (filter (lambda (tid) ;; filter out toplevel tests
					     (let ((tdat (hash-table-ref testsdat tid)))
					       (not (equal? (db:test-get-item-path tdat) ""))))
					   tests-id-lst)))
		   (if (not (null? item-tests)) ;; resist bad data, generally should not fail this condition
		       (hash-table-set! tests 
		       (hash-table-set! test-ids-by-name 
					testname 
					(dboard:sort-testsdat-by-event-time item-tests testsdat)))))))
	 (hash-table-keys test-ids-by-name))
	;; finally sort by the event time of the first test
	(sort (hash-table-values test-ids-by-name)
	      (lambda (a b)
		(< (db:test-get-event_time (hash-table-ref testsdat (car a)))
		   (db:test-get-event_time (hash-table-ref testsdat (car b))))))))))

(define (dashboard:run-times-tab-updater commondat tabdat tab-num)
  ;; each test is an object in the run component