Megatest

Check-in [5baad3fe0b]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Stuff eh. On the shuttle
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | multi-area
Files: files | file ages | folders
SHA1: 5baad3fe0bdc69b5e59c7ae36f2a7497ecc719b9
User & Date: matt on 2015-04-07 09:07:08
Other Links: branch diff | manifest | tags
Context
2015-04-08
18:22
More clean up check-in: 3eb16c4cd9 user: mrwellan tags: multi-area
2015-04-07
09:07
Stuff eh. On the shuttle check-in: 5baad3fe0b user: matt tags: multi-area
2015-04-06
23:42
Initial framework for multi-area browser check-in: d70f24bd1d user: matt tags: multi-area
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [fdc46f2740] to [609c3adc2f].

︙
42
43
44
45
46
47
48


49
50
51
52
53
54
55

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57








+
+








  path
  transport
  configinfo
  configdat
  denoise
  client-signature
  remote
  run-keys
  runs      ;; used in dashboard
  )

(define *already-seen-runconfig-info* #f)
(define *waiting-queue*     (make-hash-table))
(define *test-meta-updated* (make-hash-table))
(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
(define *passnum*           0) ;; when running track calls to run-tests or similar
︙

Modified dashboard.scm from [e9e3717492] to [42ca30b425].

︙
439
440
441
442
443
444
445
446

447
448
449
450
451
452
453

439
440
441
442
443
444
445

446
447
448
449
450
451
452
453








-
+








		    steps-matrix
		    data-matrix)))
	 (iup:attribute-set! tabs "TABTITLE0" "Test Steps")
	 (iup:attribute-set! tabs "TABTITLE1" "Test Data")
	 tabs)))))
       
;; Test browser
(define (tree-browser data window-id)
(define (tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((tree-path (tree:node->path obj id))
			    (area      (car tree-path))
︙
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

560
561
562
563
564
565
566
567
568
569
570
571
572
573

574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590






591
592
593




594
595
596
597
598
599
600
601
602
603
604
605
606
607





608
609
610
























611
612
613
614
615





616
617
618
619
620
621
622
623
624
625
626
627

628
629

630
631
632
633
634
635
636

528
529
530
531
532
533
534


















535
536
537
538
539
540

541
542
543
544
545
546
547
548
549
550
551
552
553
554

555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578



579
580
581
582

583
584
585
586
587
588
589
590





591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622





623
624
625
626
627


628
629
630
631
632
633
634
635
636

637
638

639
640
641
642
643
644
645
646








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+













-
+

















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








-
-
-
-
-
+
+
+
+
+



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









-
+

-
+








		))
	      (dcommon:populate-steps steps-dat steps-matrix))))))
		;;(list meta-dat-matrix
		;;      (if test-id
		;;	  (list (

  
;; db:test-get-id           
;; db:test-get-run_id       
;; db:test-get-testname     
;; db:test-get-state        
;; db:test-get-status       
;; db:test-get-event_time   
;; db:test-get-host         
;; db:test-get-cpuload      
;; db:test-get-diskfree     
;; db:test-get-uname        
;; db:test-get-rundir       
;; db:test-get-item-path    
;; db:test-get-run_duration 
;; db:test-get-final_logf   
;; db:test-get-comment      
;; db:test-get-fullname     	  


;;======================================================================
;; R U N   C O N T R O L
;;======================================================================

;; General displayer
;;
(define (area-display data window-id)
(define (area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3
			   #:numlin-visible 3
			   #:click-cb (lambda (obj lin col status)
					(print "obj: " obj " lin: " lin " col: " col " status: " status)))))

    (iup:attribute-set! view-matrix "RESIZEMATRIX" "YES")
    (iup:attribute-set! view-matrix "WIDTH0" "100")

    (dboard:area-matrix-set! adat view-matrix)
    ;; (dboard:data-set-runs-matrix! *data* runs-matrix)
    (iup:hbox
     (iup:frame 
      #:title "Runs browser"
      (iup:vbox
       view-matrix)))))

;; Browse and control a single run
;;
(define (runcontrol window-id)
  (iup:hbox))

;;======================================================================
;; D A S H B O A R D
;;======================================================================

(define (make-area-panel data area-name window-id)
  (let* ((adat   (hash-table-ref areas area-name))
	 (tb     (tree-browser data adat window-id)) ;; (dboard:areas-tree-browser data)
	 (ad     (area-display data adat window-id))
	(areas  (dboard:data-areas data)))
    (dboard:area-tree-set!   adat tb)
    (dboard:area-matrix-set! adat ad)
  (iup:split
   #:value 200
   (tree-browser data window-id) ;; (dboard:areas-tree-browser data)
    (iup:split
     #:value 200
     tb ad)))

   (area-display data window-id)))

;; Main Panel
(define (main-panel data window-id)
  (iup:dialog
   #:title "Megatest Control Panel"
   #:menu (dcommon:main-menu data)
   #:shrink "YES"
   (iup:vbox
    (let* ((area-names (hash-table-keys (dboard:areas-area-groups data)))
	   (areas (map (lambda (aname)
			 (make-area-panel data aname window-id))
		       area-names))
	   (tabtop (apply iup:tabs areas)))
    (let* ((area-names  (hash-table-keys (dboard:data-cfgdat data)))
	   (area-panels (map (lambda (aname)
			       (make-area-panel data aname window-id))
			     area-names))
	   (tabtop      (apply iup:tabs areas)))
      (let loop ((index 0)
		 (hed   (car area-names))
		 (tal   (cdr area-names)))
	(let* ((apath   (hash-table-ref (dboard:data-cfgdat data)) hed)
	       (mtconf    (read-config apath (make-hash-table) #f)) ;; megatest.config
	       (area-dat (make-megatest:area
			  hed      ;; area name
			  apath    ;; path to area
			  'http    ;; transport
			  (list apath mtconf) ;; configinfo (legacy)
			  mtconf   ;; megatest.config
			  (make-hash-table)
			  #f
			  #f       ;; remote connections
			  #f       ;; run keys
			  (make-hash-table) ;; run-id -> (hash of test-ids => dat)
			  )))
	  (hash-table-set! (dboard:data-areas data) hed 
			   (make-dboard:area
			    #f ;; tree
			    #f ;; matrix
			    (and (file-exists?       apath)
				 (file-write-access? apath))
			    area-dat
			    hed 

			    ))
	(debug:print 0 "Adding area " hed " with index " index " to dashboard")
	(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	(if (not (null? tal))
	    (loop (+ index 1)(car tal)(cdr tal))))
      tabtop))))
	  (debug:print 0 "Adding area " hed " with index " index " to dashboard")
	  (iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	  (if (not (null? tal))
	      (loop (+ index 1)(car tal)(cdr tal))))
	tabtop)))))

(define *current-window-id* 0)

(define (newdashboard data window-id)
  (let* (;; (keys     (db:get-keys *dbstruct-local* *area-dat*))
	 ;; (runname  "%")
	 ;; (testpatt "%")
	 ;; (keypatts (map (lambda (k)(list k "%")) keys))
	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:areas-current-window-id-set! data (+ 1 (dboard:areas-current-window-id data)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (main-panel data (dboard:areas-current-window-id data)))
    (iup:show (main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
    ;; (iup:show (main-panel my-window-id))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if
︙
646
647
648
649
650
651
652
653
654



655
656

657
658
659

656
657
658
659
660
661
662


663
664
665
666

667

668
669








-
-
+
+
+

-
+
-




;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id
;;;
(let* ((window-id 0)
       (groupn    (or (args:get-arg "-group") "default"))
       (cfname    (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
       (cfgdat    (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
       (data      (make-dboard:areas 
		   cfgdat
       (data      (make-dboard:data
		   cfgdat ;; this is the data from ~/.megatest for the selected group
		   (make-hash-table) ;; areaname -> area-rec
		   0 
		   #f)))
		   )))
  ;; (dboard:areas-tree-browser-set! data (tree-browser data window-id)) ;; data will have "areaname" => "area record" entries
  (newdashboard data window-id)
  (iup:main-loop))

Modified dcommon.scm from [c2f511dfd7] to [f5b7561c68].

︙
35
36
37
38
39
40
41
42
43



44
45
46
47
48


49
50
51
52
53
54
55
56
57
58
59
60
61
62

63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82

35
36
37
38
39
40
41


42
43
44
45

46
47
48
49
50
51

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72




73

74
75
76
77
78
79
80








-
-
+
+
+

-



+
+

-












+








-
-
-
-
+
-








;;======================================================================
;; 
;; A single data structure for all the data used in a dashboard for
;; all areas tracked.
;;


(define-record dboard:areas
  area-groups          ;; hash of group -> areanames -> areapaths
(define-record dboard:data
  cfgdat            ;; data from ~/.megatest/<group>.dat
  areas             ;; hash of areaname -> area-rec
  current-window-id
  tree-browser
  )

(define-record dboard:area
  tree
  matrix
  read-only ;; #t => can't write
  dbstruct  ;; database connector
  area-dat  ;; the one-structure (one day dbstruct will be put in here)
  name      ;; name for this area
  mpath     ;; path to the megatest home (MT_RUN_AREA_HOME)
  view-path ;; <target/path>/<runname>/...
  view-type ;; standard, etc.
  matrix    ;; the spreadsheet 
  controls  ;; the controls
  data      ;; all the data kept in sync with db
  filters   ;; user filters 
  run-id    ;; the current run-id
  test-ids  ;; the current test id hash, run-id => test-id
  command   ;; the command from the entry field
  ;; dbstruct ;; not needed
  )

(define-record dboard:filter
  target    ;; hash of widgets for the target
  runname   ;; the runname widget
  testpatt  ;; the testpatt widget
  )

(define-record dboard:area-dat
  run-keys
  runs
  tests
;; Use megatest:area from common.scm for an area record
  )  

;;======================================================================
;; D O T F I L E
;;======================================================================

;; write a sexp list to fname
;;
︙

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