Megatest

Check-in [255dbe1f68]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Runs tree for run summary in place
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev | kind-db-access
Files: files | file ages | folders
SHA1: 255dbe1f68e6a5216431bef9f0286172e5ac16ab
User & Date: matt on 2013-07-05 10:10:34
Other Links: branch diff | manifest | tags
Context
2013-07-05
16:25
Runs summary working nicely check-in: c76a0c089e user: matt tags: dev, kind-db-access
10:10
Runs tree for run summary in place check-in: 255dbe1f68 user: matt tags: dev, kind-db-access
2013-07-04
23:45
Beginnings of run summary view in place check-in: bc7b3cac87 user: matt tags: dev, kind-db-access
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [e506d58959] to [e1d233708f].

︙
27
28
29
30
31
32
33

34
35
36
37
38
39
40

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41








+








(declare (uses db))
(declare (uses configf))
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses dashboard-guimonitor))
(declare (uses tree))
(declare (uses dcommon))

;; (declare (uses dashboard-main))
(declare (uses megatest-version))
(declare (uses mt))

(include "common_records.scm")
︙
649
650
651
652
653
654
655


656
657
658
659
660
661
662
663
664
665
666


667

668
669
670
671
672
673
674
675
676
677
678
679


































680
681
682
683
684
685
686

650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671

672
673
674
675
676
677
678
679
680
681
682
683

684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724








+
+











+
+
-
+











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








      #f))

(define dashboard:update-run-summary-tab #f)

;; (define (tests window-id)
(define (dashboard:one-run)
  (let* ((tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((run-path (tree:node->path obj id))
			    (run-id   (tree-path->run-id (cdr run-path))))
		       (if run-id
			   (dboard:data-set-curr-run-id *data*))
		       (print "path: " (tree:node->path obj id) " run-id: " run-id)))))
	 (run-matrix (iup:matrix
		      #:expand "YES"))
	 (updater  (lambda ()
		     (let* ((runs-dat     (mt:get-runs-by-patt *keys* "%" #f))
			    (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
		     (let* ((run-id       (dboard:data-get-curr-run-id *data*))
			    (run-id       (dboard:data-get-curr-run-id *data*))
			    (tests-dat    (mt:get-tests-for-run run-id "%" '() '()
								qryval: "id,testname,item_path,state,status")) ;; get 'em all
			    (tests-mindat (dcommon:minimize-test-data tests-dat))
			    (indices      (common:sparse-list-generate-index tests-mindat)) ;;  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 (- *num-tests* 15) 3)) ;; *num-tests* is proportional to the size of the window
			    (numrows      1)
			    (numcols      1)
			    (changed      #f))
			    (changed      #f)
			    (runs-hash    (let ((ht (make-hash-table)))
					    (for-each (lambda (run)
							(hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
						      (vector-ref runs-dat 1))
					    ht))
			    (run-ids      (sort (filter number? (hash-table-keys runs-hash))
						(lambda (a b)
						  (let* ((record-a (hash-table-ref runs-hash a))
							 (record-b (hash-table-ref runs-hash b))
							 (time-a   (db:get-value-by-header record-a runs-header "event_time"))
							 (time-b   (db:get-value-by-header record-b runs-header "event_time")))
						    (> time-a time-b))))))
		       
		       ;; (iup:attribute-set! tb "VALUE" "0")
		       ;; (iup:attribute-set! tb "NAME" "Runs")
		       ;; Update the runs tree
		       (for-each (lambda (run-id)
				   (let* ((run-record (hash-table-ref/default runs-hash run-id #f))
					  (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
							   *keys*))
					  (run-name   (db:get-value-by-header run-record runs-header "runname"))
					  (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
					  (run-path   (append key-vals (list run-name))))
				     (hash-table-set! (dboard:data-get-run-keys *data*) run-id run-path)
				     ;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*)
				     ;;    		 (conc rownum ":" colnum) col-name)
				     ;; (hash-table-set! runid-to-col run-id (list colnum run-record))
				     ;; Here we update the tests treebox and tree keys
				     (tree:add-node tb "Runs" (append key-vals (list run-name))
						    userdata: (conc "run-id: " run-id))
				     ;; (set! colnum (+ colnum 1))
				     ))
				 run-ids)
		       (iup:attribute-set! run-matrix "CLEARVALUE" "CONTENTS")
		       (iup:attribute-set! run-matrix "NUMCOL" max-col )
		       (iup:attribute-set! run-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20
		       (iup:attribute-set! run-matrix "NUMCOL_VISIBLE" max-col)
		       (iup:attribute-set! run-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row))
		       
		       ;; Row labels
︙
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737

759
760
761
762
763
764
765



766
767
768
769
770
771
772








-
-
-








				     (if (not (equal? (iup:attribute run-matrix key) value))
					 (begin
					   (set! changed #t)
					   (iup:attribute-set! run-matrix key value)))))
				 tests-mindat)
		       (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL"))))))
    (set! dashboard:update-run-summary-tab updater)
    (iup:attribute-set! tb "VALUE" "0")
    (iup:attribute-set! tb "NAME" "Runs")
    ;;(iup:attribute-set! tb "ADDEXPANDED" "NO")
    (dboard:data-set-runs-tree! *data* tb)
    (iup:hbox 
     tb
     run-matrix)))

;;======================================================================
;; R U N S
︙

Modified db.scm from [0047dcf661] to [97955e1756].

︙
711
712
713
714
715
716
717
718

719
720
721
722
723
724
725

711
712
713
714
715
716
717

718
719
720
721
722
723
724
725








-
+








  (let* ((tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
	 (keystr   (car tmp))
	 (header   (cadr tmp))
	 (res     '())
	 (key-patt "")
	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
	 (qry-str  #f)
	 (keyvals  (keys:target->keyval keys targpatt)))
	 (keyvals  (if targpatt (keys:target->keyval keys targpatt) '())))
    (for-each (lambda (keyval)
		(let* ((key    (car keyval))
		       (patt   (cadr keyval))
		       (fulkey (conc ":" key))
		       (wildtype (if (substring-index "%" patt) "like" "glob")))
		  (if patt
		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
︙

This page was generated in about 0.117s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00