Megatest

Check-in [528c8eab48]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:More command line launching support done
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: 528c8eab4857d5bcc8293dd2a062ecbff11f95a7
User & Date: matt on 2013-07-07 15:19:49
Other Links: branch diff | manifest | tags
Context
2013-07-07
18:10
Corrected runname in remove-runs, merged runconfigs targets with previously run targets check-in: 62658bc8bb user: matt tags: dev
15:19
More command line launching support done check-in: 528c8eab48 user: matt tags: dev
13:16
Partially complete generation of command line for local running check-in: 57b2d5e1f5 user: matt tags: dev
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [aab4695122] to [fa9ef8f681].

︙
307
308
309
310
311
312
313




314
315
316
317
318
319
320

307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324








+
+
+
+








	  (if (> min 0)(conc min "m ")  "")
	  sec "s")))

(define (seconds->time-string sec)
  (time->string 
   (seconds->local-time sec) "%H:%M:%S"))

(define (seconds->work-week/day sec)
  (time->string
   (seconds->local-time sec) "%V.%u"))

;;======================================================================
;; Colors
;;======================================================================
      
(define (common:name->iup-color name)
  (case (string->symbol (string-downcase name))
    ((red)    "223 33 49")
︙

Modified dashboard.scm from [741829247b] to [2c640571a0].

︙
507
508
509
510
511
512
513
514


515
516
517



518
519
520
521
522
523
524
525
526
527
528
529
530
531

532
533

534
535










536
537
538
539
540
541
542

507
508
509
510
511
512
513

514
515
516
517

518
519
520
521
522
523
524
525
526
527
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








-
+
+


-
+
+
+













-
+

-
+

-
+
+
+
+
+
+
+
+
+
+








		items))))

;; Extract the various bits of data from *data* and create the command line equivalent that will be displayed
;;
(define (dashboard:update-run-command)
  (let* ((cmd-tb       (dboard:data-get-command-tb *data*))
	 (cmd          (dboard:data-get-command    *data*))
	 (test-patt    (dboard:data-get-test-patts *data*))
	 (test-patt    (let ((tp (dboard:data-get-test-patts *data*)))
			 (if (equal? tp "") "%" tp)))
	 (states       (dboard:data-get-states     *data*))
	 (statuses     (dboard:data-get-statuses   *data*))
	 (target       (dboard:data-get-target     *data*))
	 (target       (let ((targ-list (dboard:data-get-target     *data*)))
			 (if targ-list (string-intersperse targ-list "/") "no-target-selected")))
	 (run-name     (dboard:data-get-run-name   *data*))
	 (states-str   (if (or (not states)
			       (null? states))
			   ""
			   (conc " :state "  (string-intersperse states ","))))
	 (statuses-str (if (or (not statuses)
			       (null? statuses))
			   ""
			   (conc " :status " (string-intersperse statuses ","))))
	 (full-cmd  "megatest"))
    (case (string->symbol cmd)
      ((runtests)
       (set! full-cmd (conc full-cmd 
			    " -runtests "
			    (if (equal? test-patt "") "%" test-patt) " "
			    test-patt
			    " -target "
			    (if target (string-intersperse target "/") "no-target-selected")
			    target
			    " :runname "
			    " somerun " ;; addme!
			    run-name
			    )))
      ((remove-runs)
       (set! full-cmd (conc full-cmd
			    " -remove-runs "
			    run-name
			    " -target " 
			    target
			    " -testpatt "
			    test-patt
			    states-str
			    statuses-str
			    )))
      (else (set! full-cmd " no valid command ")))
    (iup:attribute-set! cmd-tb "VALUE" full-cmd)))

(define (dashboard:draw-tests cnv xadj yadj test-draw-state sorted-testnames)
︙
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
647
648
649
650
651
652
653
654
655
656











657

658
659
660
661
662
663
664

623
624
625
626
627
628
629
630
631





632
633
634
635
636
637








638
639
640
641
642
643
644
645
646
647
648
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
687

688
689
690
691
692
693
694
695








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

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

-
+










-
-
+
+











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








    (hash-table-set! tests-draw-state 'scalef 8)
    (tests:get-full-data test-names test-records '())
    (set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
    
    ;; refer to *keys*, *dbkeys* for keys
    (iup:vbox
     ;; The command line display/exectution control
     (iup:frame
      #:title "Command to be exectuted"
     (iup:hbox
      (iup:label "Run on" #:size "40x")
      (iup:radio 
       (iup:hbox
	(iup:toggle "Local" #:size "40x")
      (iup:hbox
       (iup:label "Run on" #:size "40x")
       (iup:radio 
	(iup:hbox
	 (iup:toggle "Local" #:size "40x")
	(iup:toggle "Server" #:size "40x")))
      (let ((tb (iup:textbox 
		 #:value "megatest "
		 #:expand "HORIZONTAL"
		 #:readonly "YES"
		 )))
	(dboard:data-set-command-tb! *data* tb)
	tb)
      (iup:button "Execute" #:size "50x"))
       (let ((tb (iup:textbox 
		  #:value "megatest "
		  #:expand "HORIZONTAL"
		  #:readonly "YES"
		  #:font "Courier New, -12"
		  )))
	 (dboard:data-set-command-tb! *data* tb)
	 tb)
       (iup:button "Execute" #:size "50x"
		   #:action (lambda (obj)
			      (let ((cmd (conc "xterm -geometry 180x20 -e \""
					       (iup:attribute (dboard:data-get-command-tb *data*) "VALUE")
					       ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
				(system cmd))))))

      (iup:split
     (iup:split
       #:orientation "HORIZONTAL"
       
       (iup:split
	;; Target, testpatt, state and status input boxes
	#:value 300
	(iup:vbox
	 ;; Command to run
	 (iup:frame
	  #:title "Set the action to take"
	  (iup:hbox
	   (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
	   (let* ((cmds-list '("runtests" "remove-runs" "set-state-status"))
	   ;; (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
	   (let* ((cmds-list '("runtests" "remove-runs" "set-state-status" "lock-runs" "unlock-runs"))
		  (lb         (iup:listbox #:expand "HORIZONTAL"
					   #:dropdown "YES"
					   #:action (lambda (obj val index lbstate)
						      ;; (print obj " " val " " index " " lbstate)
						      (dboard:data-set-command! *data* val)
						      (dashboard:update-run-command))))
		  (default-cmd (car cmds-list)))
	     (iuplistbox-fill-list lb cmds-list selected-item: default-cmd)
	     (dboard:data-set-command! *data* default-cmd)
	     lb)))
	 (iup:frame
	  #:title "Runname"
	  (let* ((default-run-name (conc "ww" (seconds->work-week/day (current-seconds))))
		 (tb (iup:textbox #:expand "HORIZONTAL"
				 #:action (lambda (obj val txt)
					    ;; (print "obj: " obj " val: " val " unk: " unk)
					    (dboard:data-set-run-name! *data* txt) ;; (iup:attribute obj "VALUE"))
					    (dashboard:update-run-command))
				 #:value default-run-name)))
	    (dboard:data-set-run-name! *data* default-run-name)
	    tb))
	 (iup:frame
	  #:title "Selectors that determine which tests will be operated on"
	  #:title "SELECTORS"
	  (iup:vbox
	   ;; Text box for test patterns
	   (iup:frame
	    #:title "Test patterns (one per line)"
	    (iup:textbox #:action (lambda (val a b)
				    (dboard:data-set-test-patts!
				     *data*
︙

Modified dcommon.scm from [cf58132549] to [0686ef81e6].

︙
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47

33
34
35
36
37
38
39

40
41
42
43
44
45
46
47








-
+








;; C O M M O N   D A T A   S T R U C T U R E
;;======================================================================
;; 
;; A single data structure for all the data used in a dashboard.
;; Share this structure between newdashboard and dashboard with the 
;; intent of converging on a single app.
;;
(define *data* (make-vector 20 #f))
(define *data* (make-vector 25 #f))
(define (dboard:data-get-runs          vec)    (vector-ref  vec 0))
(define (dboard:data-get-tests         vec)    (vector-ref  vec 1))
(define (dboard:data-get-runs-matrix   vec)    (vector-ref  vec 2))
(define (dboard:data-get-tests-tree    vec)    (vector-ref  vec 3))
(define (dboard:data-get-run-keys      vec)    (vector-ref  vec 4))
(define (dboard:data-get-curr-test-ids vec)    (vector-ref  vec 5))
;; (define (dboard:data-get-test-details  vec)    (vector-ref  vec 6))
︙
55
56
57
58
59
60
61


62
63
64
65
66
67
68

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70








+
+








  (let ((val (vector-ref  vec 12)))(if val val "")))
(define (dboard:data-get-states        vec)    (vector-ref vec 13))
(define (dboard:data-get-statuses      vec)    (vector-ref vec 14))
(define (dboard:data-get-logs-textbox  vec val)(vector-ref vec 15))
(define (dboard:data-get-command       vec)    (vector-ref vec 16))
(define (dboard:data-get-command-tb    vec)    (vector-ref vec 17))
(define (dboard:data-get-target        vec)    (vector-ref vec 18))
(define (dboard:data-get-run-name      vec)    (vector-ref vec 19))


(define (dboard:data-set-runs!          vec val)(vector-set! vec 0 val))
(define (dboard:data-set-tests!         vec val)(vector-set! vec 1 val))
(define (dboard:data-set-runs-matrix!   vec val)(vector-set! vec 2 val))
(define (dboard:data-set-tests-tree!    vec val)(vector-set! vec 3 val))
(define (dboard:data-set-run-keys!      vec val)(vector-set! vec 4 val))
(define (dboard:data-set-curr-test-ids! vec val)(vector-set! vec 5 val))
︙
77
78
79
80
81
82
83

84
85
86
87
88
89
90

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93








+








  (vector-set! vec 12 (if (equal? val "") #f val)))
(define (dboard:data-set-states!        vec val)(vector-set! vec 13 val))
(define (dboard:data-set-statuses!      vec val)(vector-set! vec 14 val))
(define (dboard:data-set-logs-textbox!  vec val)(vector-set! vec 15 val))
(define (dboard:data-set-command!       vec val)(vector-set! vec 16 val))
(define (dboard:data-set-command-tb!    vec val)(vector-set! vec 17 val))
(define (dboard:data-set-target!        vec val)(vector-set! vec 18 val))
(define (dboard:data-set-run-name!      vec val)(vector-set! vec 19 val))

(dboard:data-set-run-keys! *data* (make-hash-table))

;; List of test ids being viewed in various panels
(dboard:data-set-curr-test-ids! *data* (make-hash-table))

;; Look up test-ids by (key1 key2 ... testname [itempath])
︙

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