Megatest

Check-in [6cffe7588b]
Login
Overview
Comment:Now have semi-decent temporal view of tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: 6cffe7588be17c01707275f982c2a00aa65b4c35
User & Date: matt on 2016-07-16 22:23:02
Other Links: branch diff | manifest | tags
Context
2016-07-16
22:47
time view - roller works for zoom in x check-in: eab45c2ec2 user: matt tags: v1.61
22:23
Now have semi-decent temporal view of tests check-in: 6cffe7588b user: matt tags: v1.61
13:38
Boxes now in right place check-in: 94ad80d186 user: matt tags: v1.61
Changes

Modified dashboard.scm from [4a617de25b] to [fe80c7ccab].

433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
					     sort-by                              ;; sort-by
					     sort-order                           ;; sort-order
					     #f ;; 'shortlist                           ;; qrytype
					     (if (dboard:tabdat-filters-changed tabdat) 
						 0
						 last-update) ;; last-update
					     *dashboard-mode*)) ;; use dashboard mode
	 (tests      (dashboard:merge-changed-tests prev-tests tmptests  (dboard:tabdat-hide-not-hide tabdat))))
    (vector-set! prev-dat 3 (- (current-seconds) 2)) ;; go back two seconds in time to ensure all changes are captured.
    ;; (debug:print 0 *default-log-port* "(dboard:get-tests-for-run-duplicate: filters-changed=" (dboard:tabdat-filters-changed tabdat) " last-update=" last-update " got " (length tmptests) " test records for run " run-id)
    tests))

;; tmptests   - new tests data
;; prev-tests - old tests data
;;
(define (dashboard:merge-changed-tests tests tmptests use-new) 
  (let ((newdat (filter
		 (lambda (x)
		   (not (equal? (db:test-get-state x) "DELETED"))) ;; remove deleted tests but do it after merging
		 (delete-duplicates (if use-new ;; (dboard:tabdat-filters-changed tabdat)
					tmptests
					(append tmptests prev-tests))
				    (lambda (a b)







|







|







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
					     sort-by                              ;; sort-by
					     sort-order                           ;; sort-order
					     #f ;; 'shortlist                           ;; qrytype
					     (if (dboard:tabdat-filters-changed tabdat) 
						 0
						 last-update) ;; last-update
					     *dashboard-mode*)) ;; use dashboard mode
	 (tests      (dashboard:merge-changed-tests prev-tests tmptests  (dboard:tabdat-hide-not-hide tabdat) prev-tests)))
    (vector-set! prev-dat 3 (- (current-seconds) 2)) ;; go back two seconds in time to ensure all changes are captured.
    ;; (debug:print 0 *default-log-port* "(dboard:get-tests-for-run-duplicate: filters-changed=" (dboard:tabdat-filters-changed tabdat) " last-update=" last-update " got " (length tmptests) " test records for run " run-id)
    tests))

;; tmptests   - new tests data
;; prev-tests - old tests data
;;
(define (dashboard:merge-changed-tests tests tmptests use-new prev-tests) 
  (let ((newdat (filter
		 (lambda (x)
		   (not (equal? (db:test-get-state x) "DELETED"))) ;; remove deleted tests but do it after merging
		 (delete-duplicates (if use-new ;; (dboard:tabdat-filters-changed tabdat)
					tmptests
					(append tmptests prev-tests))
				    (lambda (a b)
1939
1940
1941
1942
1943
1944
1945

1946



1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
			    (run-full-name (string-intersperse key-vals "/"))
			    (runcomp  (vg:comp-new));; new component for this run
			    (rows-used (make-hash-table)) ;; keep track of what parts of the rows are used here row1 = (obj1 obj2 ...)
			    (row-height 4)
			    (run-start  (apply min (map db:test-get-event_time testsdat)))
			    (run-end    (apply max (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat)))
			    (timeoffset (- (+ originx canvas-margin) run-start))

			    (timescale  (/ (- sizex (* 2 canvas-margin)) (- run-end run-start)))



			    (maptime    (lambda (tsecs)(* timescale (+ tsecs timeoffset)))))
		       (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx)
		       (vg:add-comp-to-lib runslib run-full-name runcomp)
		       ;; get tests in list sorted by event time ascending
		       (for-each 
			(lambda (testdat)
			  (let* ((event-time   (maptime (db:test-get-event_time   testdat)))
				 (run-duration (* timescale (db:test-get-run_duration testdat)))
				 (end-time     (+ event-time run-duration))
				 (test-name    (db:test-get-testname     testdat))
				 (item-path    (db:test-get-item-path    testdat))
				 (state         (db:test-get-state       testdat))
				 (status        (db:test-get-status      testdat))
				 (test-fullname (conc test-name "/" item-path))
				 (name-color    (gutils:get-color-for-state-status state status)))
			    (print "event_time: " (db:test-get-event_time   testdat) " mapped event_time: " event-time)
			    (print "run-duration: "  (db:test-get-run_duration testdat) " mapped run_duration: " run-duration)
			    (let loop ((rownum start-row)) ;; (+ start-row 1)))
			      (set! start-row (max rownum start-row)) ;; track the max row used
			      (if (dashboard:row-collision rowhash rownum event-time end-time)
				  (loop (+ rownum 1))
				  (let* ((lly (- sizey (* rownum row-height)))
					 (uly (+ lly row-height)))
				    (dashboard:add-bar rowhash rownum event-time end-time)







>
|
>
>
>

|













|
|







1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
			    (run-full-name (string-intersperse key-vals "/"))
			    (runcomp  (vg:comp-new));; new component for this run
			    (rows-used (make-hash-table)) ;; keep track of what parts of the rows are used here row1 = (obj1 obj2 ...)
			    (row-height 4)
			    (run-start  (apply min (map db:test-get-event_time testsdat)))
			    (run-end    (apply max (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat)))
			    (timeoffset (- (+ originx canvas-margin) run-start))
			    (run-duration (- run-end run-start))
			    (timescale  (/ (- sizex (* 2 canvas-margin))
					   (if (> run-duration 0)
					       run-duration
					       (current-seconds)))) ;; a least lously guess
			    (maptime    (lambda (tsecs)(* timescale (+ tsecs timeoffset)))))
		       ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx)
		       (vg:add-comp-to-lib runslib run-full-name runcomp)
		       ;; get tests in list sorted by event time ascending
		       (for-each 
			(lambda (testdat)
			  (let* ((event-time   (maptime (db:test-get-event_time   testdat)))
				 (run-duration (* timescale (db:test-get-run_duration testdat)))
				 (end-time     (+ event-time run-duration))
				 (test-name    (db:test-get-testname     testdat))
				 (item-path    (db:test-get-item-path    testdat))
				 (state         (db:test-get-state       testdat))
				 (status        (db:test-get-status      testdat))
				 (test-fullname (conc test-name "/" item-path))
				 (name-color    (gutils:get-color-for-state-status state status)))
			    ;; (print "event_time: " (db:test-get-event_time   testdat) " mapped event_time: " event-time)
			    ;; (print "run-duration: "  (db:test-get-run_duration testdat) " mapped run_duration: " run-duration)
			    (let loop ((rownum start-row)) ;; (+ start-row 1)))
			      (set! start-row (max rownum start-row)) ;; track the max row used
			      (if (dashboard:row-collision rowhash rownum event-time end-time)
				  (loop (+ rownum 1))
				  (let* ((lly (- sizey (* rownum row-height)))
					 (uly (+ lly row-height)))
				    (dashboard:add-bar rowhash rownum event-time end-time)
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
		       (let* ((extents (vg:components-get-extents runcomp))
			      (llx     (list-ref extents 0))
			      (lly     (list-ref extents 1))
			      (ulx     (list-ref extents 2))
			      (uly     (list-ref extents 3))
			      ;; move the following into mapping functions in vg.scm
			      (deltax  (- llx ulx))
			      (scalex  (/ sizex deltax))
			      (sllx    (* scalex llx))
			      (offx    (- sllx originx)))
			 (print "llx: " llx " lly: " lly "ulx: " ulx " uly: " uly " deltax: " deltax " scalex: " scalex " sllx: " sllx " offx: " offx)
			 (print " run-full-name: " run-full-name)
			 ;; (vg:instantiate drawing "runslib" run-full-name "wrongname" offx 0))))) 
			 (vg:instantiate drawing "runslib" run-full-name "wrongname" 0 0))))) 
			;;		 scalex: scalex scaley: 1)))))
	       allruns)
	      (vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)(dboard:tabdat-cnv tabdat)) ;; cnv-obj)
	      (canvas-clear! (dboard:tabdat-cnv tabdat)) ;; -obj)
	      (print "All objs: " (vg:draw (dboard:tabdat-drawing tabdat) #t))
	      )))
	(print "no tabdat for run-times-tab-updater"))))







|





|







1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
		       (let* ((extents (vg:components-get-extents runcomp))
			      (llx     (list-ref extents 0))
			      (lly     (list-ref extents 1))
			      (ulx     (list-ref extents 2))
			      (uly     (list-ref extents 3))
			      ;; move the following into mapping functions in vg.scm
			      (deltax  (- llx ulx))
			      (scalex  (if (> deltax 0)(/ sizex deltax) 1))
			      (sllx    (* scalex llx))
			      (offx    (- sllx originx)))
			 (print "llx: " llx " lly: " lly "ulx: " ulx " uly: " uly " deltax: " deltax " scalex: " scalex " sllx: " sllx " offx: " offx)
			 (print " run-full-name: " run-full-name)
			 ;; (vg:instantiate drawing "runslib" run-full-name "wrongname" offx 0))))) 
			 (vg:instantiate drawing "runslib" run-full-name run-full-name 0 0))))) 
			;;		 scalex: scalex scaley: 1)))))
	       allruns)
	      (vg:drawing-cnv-set! (dboard:tabdat-drawing tabdat)(dboard:tabdat-cnv tabdat)) ;; cnv-obj)
	      (canvas-clear! (dboard:tabdat-cnv tabdat)) ;; -obj)
	      (print "All objs: " (vg:draw (dboard:tabdat-drawing tabdat) #t))
	      )))
	(print "no tabdat for run-times-tab-updater"))))

Modified vg.scm from [382e81ebe7] to [885c0f1d84].

240
241
242
243
244
245
246
247




248
249
250
251
252
253
254
    (list llx lly ulx uly)))

;;======================================================================
;; color
;;======================================================================

(define (vg:rgb->number r g b #!key (a 0))
   (u32vector-ref (blob->u32vector (u8vector->blob (list->u8vector (list a r g b)))) 0))





(define (vg:iup-color->number iup-color)
  (apply vg:rgb->number (map string->number (string-split iup-color))))

;;======================================================================
;; Unravel and draw the objects
;;======================================================================







|
>
>
>
>







240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
    (list llx lly ulx uly)))

;;======================================================================
;; color
;;======================================================================

(define (vg:rgb->number r g b #!key (a 0))
  (bitwise-ior
    (arithmetic-shift a 24)
    (arithmetic-shift r 16)
    (arithmetic-shift g 8)
    b))

(define (vg:iup-color->number iup-color)
  (apply vg:rgb->number (map string->number (string-split iup-color))))

;;======================================================================
;; Unravel and draw the objects
;;======================================================================