Megatest

Check-in [9aaa15bf91]
Login
Overview
Comment:Tests now show up on time line
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: 9aaa15bf91b747d1eee0636d327fd835ea698738
User & Date: matt on 2016-07-16 06:19:50
Other Links: branch diff | manifest | tags
Context
2016-07-16
13:38
Boxes now in right place check-in: 94ad80d186 user: matt tags: v1.61
06:19
Tests now show up on time line check-in: 9aaa15bf91 user: matt tags: v1.61
2016-07-15
00:18
dashboard compiles now check-in: e13bddd3c6 user: matt tags: v1.61
Changes

Modified dashboard.scm from [bfb156a634] to [f220243be5].

1893
1894
1895
1896
1897
1898
1899
1900


1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919


1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938






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

1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
  (hash-table-set! rowhash rownum (cons (cons x1 x2) 
					(hash-table-ref/default rowhash rownum '()))))

(define (dashboard:run-times-tab-updater commondat tab-num)
  ;; each test is an object in the run component
  ;; each run is a component
  ;; all runs stored in runslib library
  (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))


    (if tabdat
	(let* ((row-height 10)
	       (drawing    (dboard:tabdat-drawing tabdat))
	       (runslib    (vg:get/create-lib drawing "runslib"))) ;; creates and adds lib
	  (update-rundat tabdat
			 "%" ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") 
			 100  ;; (dboard:tabdat-numruns tabdat)
			 "%" ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
			 (let ((res '()))
			   (for-each (lambda (key)
				       (if (not (equal? key "runname"))
					   (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
					     (if val (set! res (cons (list key val) res))))))
				     (dboard:tabdat-dbkeys tabdat))
			   res))
	  (let ((allruns (dboard:tabdat-allruns tabdat))
		(rowhash (make-hash-table)) ;; store me in tabdat
		(cnv     (dboard:tabdat-cnv tabdat)))


	    (print "allruns: " allruns)
	    (for-each
	     (lambda (rundat)
	       (if (vector? rundat)
		   (let* ((run      (vector-ref rundat 0))
			  (testsdat  (sort (vector-ref rundat 1)
					   (lambda (a b)
					     (< (db:test-get-event_time a)
						(db:test-get-event_time b)))))
			  (key-val-dat (vector-ref rundat 2))
			  (run-id   (db:get-value-by-header run (dboard:tabdat-header tabdat) "id"))
			  (key-vals (append key-val-dat
					    (list (let ((x (db:get-value-by-header run (dboard:tabdat-header tabdat) "runname")))
						    (if x x "")))))
			  (run-key  (string-intersperse key-vals "\n"))
			  (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))






		     (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   (/ (db:test-get-event_time   testdat) 60.0))
			       (run-duration (/ (db:test-get-run_duration testdat) 60.0))
			       (end-time     (+ event-time run-duration))
			       (test-name    (db:test-get-testname     testdat))
			       (item-path    (db:test-get-item-path    testdat))
			       (test-fullname (conc test-name "/" item-path)))


			  (let loop ((rownum 0))

			    (if (dashboard:row-collision rowhash rownum event-time end-time)
				(loop (+ rownum 1))
				(let* ((lly (* rownum row-height))
				       (uly (+ lly row-height)))
				  (dashboard:add-bar rowhash rownum event-time end-time)
				  (vg:add-objs-to-comp runcomp (vg:make-rect event-time lly end-time uly)))))
			  ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
			  ))
		      testsdat)
		     ;; instantiate the component 
		     (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
				  ((originx originy)             (canvas-origin cnv)))
		       (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 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)
	    (vg:draw (dboard:tabdat-drawing tabdat) #t)
	    ))
	(print "no tabdat for run-times-tab-updater"))))

(define (dashboard:runs-tab-updater commondat tab-num)
  (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
    (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat)
		   (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
		   ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")







|
>
>



















>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
>
>
|
>
|
|
|
|
|
|
|
|
|
|
<
<












>
|
>
|
|
|
|
|







1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
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
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
  (hash-table-set! rowhash rownum (cons (cons x1 x2) 
					(hash-table-ref/default rowhash rownum '()))))

(define (dashboard:run-times-tab-updater commondat tab-num)
  ;; each test is an object in the run component
  ;; each run is a component
  ;; all runs stored in runslib library
  (let ((tabdat        (dboard:common-get-tabdat commondat tab-num: tab-num))
	(canvas-margin 20)
	(start-row     0)) ;; each run starts in this row
    (if tabdat
	(let* ((row-height 10)
	       (drawing    (dboard:tabdat-drawing tabdat))
	       (runslib    (vg:get/create-lib drawing "runslib"))) ;; creates and adds lib
	  (update-rundat tabdat
			 "%" ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") 
			 100  ;; (dboard:tabdat-numruns tabdat)
			 "%" ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
			 (let ((res '()))
			   (for-each (lambda (key)
				       (if (not (equal? key "runname"))
					   (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
					     (if val (set! res (cons (list key val) res))))))
				     (dboard:tabdat-dbkeys tabdat))
			   res))
	  (let ((allruns (dboard:tabdat-allruns tabdat))
		(rowhash (make-hash-table)) ;; store me in tabdat
		(cnv     (dboard:tabdat-cnv tabdat)))
	    (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
			 ((originx originy)             (canvas-origin cnv)))
	      (print "allruns: " allruns)
	      (for-each
	       (lambda (rundat)
		 (if (vector? rundat)
		     (let* ((run      (vector-ref rundat 0))
			    (testsdat  (sort (vector-ref rundat 1)
					     (lambda (a b)
					       (< (db:test-get-event_time a)
						  (db:test-get-event_time b)))))
			    (key-val-dat (vector-ref rundat 2))
			    (run-id   (db:get-value-by-header run (dboard:tabdat-header tabdat) "id"))
			    (key-vals (append key-val-dat
					      (list (let ((x (db:get-value-by-header run (dboard:tabdat-header tabdat) "runname")))
						      (if x x "")))))
			    (run-key  (string-intersperse key-vals "\n"))
			    (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))
				 (test-fullname (conc test-name "/" item-path)))
			    (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)
				    (vg:add-objs-to-comp runcomp (vg:make-rect event-time lly end-time uly)))))
			    ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
			    ))
			testsdat)
		       ;; instantiate the component 


		       (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"))))

(define (dashboard:runs-tab-updater commondat tab-num)
  (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
    (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat)
		   (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
		   ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")