Megatest

Check-in [c0455cef0a]
Login
Overview
Comment:Cherry pick from de6124e350: Manual tweaks to display of tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | rebase-envprocessing
Files: files | file ages | folders
SHA1: c0455cef0af1538c2d2dbd98f33ad8777d713c25
User & Date: mrwellan on 2016-04-28 08:41:37
Other Links: branch diff | manifest | tags
Context
2016-04-28
08:41
Cherry pick from 67f07adab1: Use env var to trigger loading scripts check-in: 9b00b2ed30 user: mrwellan tags: rebase-envprocessing
08:41
Cherry pick from de6124e350: Manual tweaks to display of tests check-in: c0455cef0a user: mrwellan tags: rebase-envprocessing
08:41
Cherry pick from 705ae1d971: *BRANCH* More dashboard refactoring check-in: 54f8464434 user: mrwellan tags: rebase-envprocessing
Changes

Modified dashboard.scm from [3f12e09023] to [a2d6eeaf25].

859
860
861
862
863
864
865
866

867
868
869
870
871
872
873
859
860
861
862
863
864
865

866
867
868
869
870
871
872
873







-
+







	       ((originx originy)             (canvas-origin cnv)))
      ;; (print "originx: " originx " originy: " originy)
      ;; (canvas-origin-set! cnv 0 (- (/ sizey 2)))
      (if (hash-table-ref/default tests-draw-state 'first-time #t)
	  (begin
	    (hash-table-set! tests-draw-state 'first-time #f)
	    (hash-table-set! tests-draw-state 'scalef 1)
	    (hash-table-set! tests-draw-state 'dotscale 60)
	    (hash-table-set! tests-draw-state 'dotscale 10.5)
	    (hash-table-set! tests-draw-state 'tests-info (make-hash-table))
	    (hash-table-set! tests-draw-state 'selected-tests (make-hash-table))
	    ;; set these 
	    (hash-table-set! tests-draw-state 'test-browse-xoffset 20) ;; (- 0 (* (/ sizex 2) (* 8 xadj))))
	    (hash-table-set! tests-draw-state 'test-browse-yoffset 20) ;; (- 0 (* (/ sizey 2) (* 8 (- 1 yadj)))))))
	    (dcommon:initial-draw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames test-records))
	  (dcommon:redraw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames test-records))

Modified launch.scm from [e7bae78b60] to [b2cf19a6c2].

157
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172
157
158
159
160
161
162
163

164

165
166
167
168
169
170
171







-
+
-







			       (if (eq? this-step-status 'fail) 'fail 'warn))
			      ((eq? overall-status 'abort) 'abort)
			      (else 'fail)))
	   (next-state       ;; "RUNNING") ;; WHY WAS THIS CHANGED TO NOT USE (null? tal) ??
	    (cond
	     ((null? tal) ;; more to run?
	      "COMPLETED")
	     (else "RUNNING")))
	     (else "RUNNING"))))
	   )
      (debug:print 4 "Exit value received: " (launch:einf-exit-code exit-info) " logpro-used: " logpro-used 
		   " this-step-status: " this-step-status " overall-status: " overall-status 
		   " next-status: " next-status " rollup-status: "  (launch:einf-rollup-status exit-info)) ;; (vector-ref exit-info 3))
      (case next-status
	((warn)
	 (launch:einf-rollup-status-set! exit-info 2) ;; (vector-set! exit-info 3 2) ;; rollup-status
	 ;; NB// test-set-status! does rdb calls under the hood

Modified tests.scm from [d8f0eca904] to [5b29cc1f30].

858
859
860
861
862
863
864

865
866
867
868
869
870
871
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872







+








(define (tests:easy-dot test-records outtype)
  (let-values (((fd temp-path) (file-mkstemp (conc "/tmp/" (current-user-name) ".XXXXXX"))))
    (let ((all-testnames (hash-table-keys test-records))
	  (temp-port     (open-output-file* fd)))
      ;; (format temp-port "This file is ~A.~%" temp-path)
      (format temp-port "digraph tests {\n")
      (format temp-port "  size=4,8\n")
      ;; (format temp-port "   splines=none\n")
      (for-each
       (lambda (testname)
	 (let* ((testrec (hash-table-ref test-records testname))
		(waitons (or (tests:testqueue-get-waitons testrec) '())))
	   (for-each
	    (lambda (waiton)
889
890
891
892
893
894
895
896



897
898
899
900
901
902
903
890
891
892
893
894
895
896

897
898
899
900
901
902
903
904
905
906







-
+
+
+








(define (tests:tests->dot test-records)
  (let ((all-testnames (hash-table-keys test-records)))
    (if (null? all-testnames)
	'()
	(let loop ((hed (car all-testnames))
		   (tal (cdr all-testnames))
		   (res (list "digraph tests {")))
		   (res (list "digraph tests {"
			      " size=\"11,11\";"
			      " ratio=0.95;")))
	  (let* ((testrec (hash-table-ref test-records hed))
		 (waitons (or (tests:testqueue-get-waitons testrec) '()))
		 (newres  (append res
				  (if (null? waitons)
				      (list (conc "   \"" hed "\";"))
				      (map (lambda (waiton)
					     (conc "   \"" waiton "\" -> \"" hed "\";"))