Megatest

Check-in [8b35992868]
Login
Overview
Comment:Replaced apply max with common:max in few places
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.62
Files: files | file ages | folders
SHA1: 8b35992868546d46c01b2a1f716ec18bea8a3a83
User & Date: matt on 2016-10-18 23:25:38
Other Links: branch diff | manifest | tags
Context
2016-10-19
00:10
Added the beginnings of a quick start check-in: ceaf296125 user: matt tags: v1.62
2016-10-18
23:25
Replaced apply max with common:max in few places check-in: 8b35992868 user: matt tags: v1.62
2016-10-17
14:36
Fixed missing [logpro] section in create-megatest-area. check-in: c74d681e4f user: mrwellan tags: v1.62, v1.6204
Changes

Modified common.scm from [8514527bdb] to [5874d3df51].

617
618
619
620
621
622
623










624
625
626
627
628
629
630
	     (hed     (car inlst))
	     (tal     (cdr inlst)))
    (if (not (null? tal))
	(loop (max hed max-val)
	      (car tal)
	      (cdr tal))
	(max hed max-val))))











;; path list to hash-table tree
;;   ((a b c)(a b d)(e b c)) => ((a (b (d) (c))) (e (b (c))))
;;
(define (common:list->htree lst)
  (let ((resh (make-hash-table)))
    (for-each







>
>
>
>
>
>
>
>
>
>







617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
	     (hed     (car inlst))
	     (tal     (cdr inlst)))
    (if (not (null? tal))
	(loop (max hed max-val)
	      (car tal)
	      (cdr tal))
	(max hed max-val))))

;; get min or max, use > for max and < for min, this works around the limits on apply
;;
(define (common:min-max comp lst)
  (if (null? lst)
      #f ;; better than an exception for my needs
      (fold (lambda (a b)
	      (if (comp a b) a b))
	    (car lst)
	    lst)))

;; path list to hash-table tree
;;   ((a b c)(a b d)(e b c)) => ((a (b (d) (c))) (e (b (c))))
;;
(define (common:list->htree lst)
  (let ((resh (make-hash-table)))
    (for-each

Modified dashboard.scm from [6bac3ad2ce] to [929e1f3c0c].

2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581

(define (dashboard:get-youngest-run-db-mod-time tabdat)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (apply max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db"))))))

(define (dashboard:monitor-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path))







|







2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581

(define (dashboard:get-youngest-run-db-mod-time tabdat)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (common:max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db"))))))

(define (dashboard:monitor-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path))
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
    (hash-table-set! rowhash 
		     (+ i rownum)
		     (cons (cons x1 x2) 
			   (hash-table-ref/default rowhash (+ i rownum) '())))
    (if (< i num-rows)
	(loop (+ i 1)))))

;; get min or max, use > for max and < for min, this works around the limits on apply
;;
(define (dboard:min-max comp lst)
  (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))))))







<
<
<
<
<
<
<
<
<
<







2644
2645
2646
2647
2648
2649
2650










2651
2652
2653
2654
2655
2656
2657
    (hash-table-set! rowhash 
		     (+ i rownum)
		     (cons (cons x1 x2) 
			   (hash-table-ref/default rowhash (+ i rownum) '())))
    (if (< i num-rows)
	(loop (+ i 1)))))











;; 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))))))
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
					      (dboard:rundat-hierdat rundat)))
			       (tests-ht  (dboard:rundat-tests rundat))
			       (all-tids  (hash-table-keys   tests-ht)) ;; (apply append hierdat)) ;; was testsdat
			       (testsdat  (hash-table-values tests-ht))
			       (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  (dboard:min-max < (map db:test-get-event_time testsdat)))
			       (run-end    (let ((re (dboard:min-max > (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat))))
					     (max re (+ 1 run-start)))) ;; use run-start+1 if run-start == run-end so delta is not zero
			       (timeoffset (- run-start)) ;; (+ fixed-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







|
|







3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
					      (dboard:rundat-hierdat rundat)))
			       (tests-ht  (dboard:rundat-tests rundat))
			       (all-tids  (hash-table-keys   tests-ht)) ;; (apply append hierdat)) ;; was testsdat
			       (testsdat  (hash-table-values tests-ht))
			       (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  (common:min-max < (map db:test-get-event_time testsdat)))
			       (run-end    (let ((re (common:min-max > (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat))))
					     (max re (+ 1 run-start)))) ;; use run-start+1 if run-start == run-end so delta is not zero
			       (timeoffset (- run-start)) ;; (+ fixed-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

Modified dcommon.scm from [adcc5f42ce] to [eb6ea73393].

214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
				  ;; (iup:attribute-set! tb (conc "COLOR" node-num) color)
				  )
				(hash-table-set! (dboard:tabdat-path-test-ids data) test-path test-id)
				(if (not rownum)
				    (let ((rownums (hash-table-values testname-to-row)))
				      (set! rownum (if (null? rownums)
						       1
						       (+ 1 (apply max rownums))))
				      (hash-table-set! testname-to-row fullname rownum)
				      ;; create the label
				      (set! changed (dcommon:modifiy-if-different 
						     (dboard:tabdat-runs-matrix data)
						     (conc rownum ":" 0)
						     dispname
						     changed))







|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
				  ;; (iup:attribute-set! tb (conc "COLOR" node-num) color)
				  )
				(hash-table-set! (dboard:tabdat-path-test-ids data) test-path test-id)
				(if (not rownum)
				    (let ((rownums (hash-table-values testname-to-row)))
				      (set! rownum (if (null? rownums)
						       1
						       (+ 1 (common:max rownums))))
				      (hash-table-set! testname-to-row fullname rownum)
				      ;; create the label
				      (set! changed (dcommon:modifiy-if-different 
						     (dboard:tabdat-runs-matrix data)
						     (conc rownum ":" 0)
						     dispname
						     changed))
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
(define (dcommon:runsdat-get-col-num dat target runname force-set)
  (let* ((runs-index (dboard:runsdat-runs-index dat))
	 (col-name   (conc target "/" runname))
	 (res        (hash-table-ref/default runs-index col-name #f)))
    (if res
	res
	(if force-set
	    (let ((max-col-num (+ 1 (apply max -1 (hash-table-values runs-index)))))
	      (hash-table-set! runs-index col-name max-col-num)
	      max-col-num)))))

(define (dcommon:runsdat-get-row-num dat testname itempath force-set)
  (let* ((tests-index (dboard:runsdat-runs-index dat))
	 (row-name    (conc testname "/" itempath))
	 (res         (hash-table-ref/default runs-index row-name #f)))
    (if res
	res
	(if force-set
	    (let ((max-row-num (+ 1 (apply max -1 (hash-table-values tests-index)))))
	      (hash-table-set! runs-index row-name max-row-num)
	      max-row-num)))))

(define (dcommon:rundat-copy-tests-to-by-name rundat)
  (let ((src-ht (dboard:rundat-tests rundat))
	(trg-ht (dboard:rundat-tests-by-name rundat)))
    (if (and (hash-table? src-ht)(hash-table? trg-ht))







|










|







266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
(define (dcommon:runsdat-get-col-num dat target runname force-set)
  (let* ((runs-index (dboard:runsdat-runs-index dat))
	 (col-name   (conc target "/" runname))
	 (res        (hash-table-ref/default runs-index col-name #f)))
    (if res
	res
	(if force-set
	    (let ((max-col-num (+ 1 (common:max (cons-1 (hash-table-values runs-index))))))
	      (hash-table-set! runs-index col-name max-col-num)
	      max-col-num)))))

(define (dcommon:runsdat-get-row-num dat testname itempath force-set)
  (let* ((tests-index (dboard:runsdat-runs-index dat))
	 (row-name    (conc testname "/" itempath))
	 (res         (hash-table-ref/default runs-index row-name #f)))
    (if res
	res
	(if force-set
	    (let ((max-row-num (+ 1 (common:max (cons -1 (hash-table-values tests-index))))))
	      (hash-table-set! runs-index row-name max-row-num)
	      max-row-num)))))

(define (dcommon:rundat-copy-tests-to-by-name rundat)
  (let ((src-ht (dboard:rundat-tests rundat))
	(trg-ht (dboard:rundat-tests-by-name rundat)))
    (if (and (hash-table? src-ht)(hash-table? trg-ht))
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	 (changed      #f)
	 (stats-updater (lambda ()
			 (if (dashboard:database-changed? commondat tabdat context-key: 'run-stats)
			     (let* ((run-stats    (rmt:get-run-stats))
				    (indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
				    (row-indices  (car indices))
				    (col-indices  (cadr indices))
				    (max-row      (if (null? row-indices) 1 (apply max (map cadr row-indices))))
				    (max-col      (if (null? col-indices) 1 
						      (apply max (map cadr col-indices))))
				    (max-visible  (max (- (dboard:tabdat-num-tests tabdat) 15) 3))
				    (max-col-vis  (if (> max-col 10) 10 max-col))
				    (numrows      1)
				    (numcols      1))
			       (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS")
			       (iup:attribute-set! stats-matrix "NUMCOL" max-col )
			       (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20







|

|







546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	 (changed      #f)
	 (stats-updater (lambda ()
			 (if (dashboard:database-changed? commondat tabdat context-key: 'run-stats)
			     (let* ((run-stats    (rmt:get-run-stats))
				    (indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
				    (row-indices  (car indices))
				    (col-indices  (cadr indices))
				    (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
				    (max-col      (if (null? col-indices) 1 
						      (common:max (map cadr col-indices))))
				    (max-visible  (max (- (dboard:tabdat-num-tests tabdat) 15) 3))
				    (max-col-vis  (if (> max-col 10) 10 max-col))
				    (numrows      1)
				    (numcols      1))
			       (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS")
			       (iup:attribute-set! stats-matrix "NUMCOL" max-col )
			       (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20

Modified runs.scm from [fb07c27494] to [9f66bcb951].

1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
		  ((and skip-check
			(configf:lookup test-conf "skip" "rundelay"))
		   ;; run-ids = #f means *all* runs
		   (let* ((numseconds      (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay")))
			  (running-tests   (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f))
			  (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex
			  (last-run-times  (map db:mintest-get-event_time completed-tests))
			  (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (apply max last-run-times)))))
		     (if (or (not (null? running-tests)) ;; have to skip if test is running
			     (> numseconds time-since-last))
			 (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago"))))))
		 
		 (if skip-test
		     (begin
		       (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "SKIP" skip-test)







|







1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
		  ((and skip-check
			(configf:lookup test-conf "skip" "rundelay"))
		   ;; run-ids = #f means *all* runs
		   (let* ((numseconds      (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay")))
			  (running-tests   (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f))
			  (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex
			  (last-run-times  (map db:mintest-get-event_time completed-tests))
			  (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (common:max last-run-times)))))
		     (if (or (not (null? running-tests)) ;; have to skip if test is running
			     (> numseconds time-since-last))
			 (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago"))))))
		 
		 (if skip-test
		     (begin
		       (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "SKIP" skip-test)