Megatest

Check-in [39718da514]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:added launch subrun dashboard to context menu
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 39718da514fa680d3b36220f278ded94fb864a8f
User & Date: bjbarcla on 2017-12-28 16:40:25
Other Links: branch diff | manifest | tags
Context
2017-12-28
18:00
enabled propagation of rerun, set-state-status to subrun; subrun goes to kill-req always but sometimes not to killed... need to figure it out. check-in: 8de562aa65 user: bjbarcla tags: v1.65
16:40
added launch subrun dashboard to context menu check-in: 39718da514 user: bjbarcla tags: v1.65
11:20
enabled remove-run to propagate to subruns check-in: 2e121e3655 user: bjbarcla tags: v1.65
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard-tests.scm from [1155a25cab] to [4a059bb6ef].

︙
26
27
28
29
30
31
32

33
34
35
36
37
38
39

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








+








(declare (uses common))
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

;;======================================================================
;; C O M M O N
︙
242
243
244
245
246
247
248
249
250
251
252
253

254
255

256
257
258
259
260
261
262
263

264
265
266
267
268
269
270

243
244
245
246
247
248
249





250


251

252
253
254
255
256
257

258
259
260
261
262
263
264
265








-
-
-
-
-
+
-
-
+
-






-
+








			   (db:test-get-uname testdat))) ;; )
	    )))))

;; if there is a submegatest create a button to launch dashboard in that area
;;
(define (submegatest-panel dbstruct keydat testdat runname testconfig)
  (let* ((test-run-dir      (db:test-get-rundir testdat))
	 (subrun-tconf-file (conc test-run-dir "/testconfig.subrun"))
	 (subrun-tconf      (if (file-exists? subrun-tconf-file)
				(configf:read-alist subrun-tconf-file)
				(make-hash-table)))
	 (subarea           (or (configf:lookup testconfig "setup" "submegatest")
	 (subarea           (subrun:get-runarea test-run-dir))
				(configf:lookup subrun-tconf "subrun" "run-area")))
	 (area-exists (and subarea (common:file-exists? subarea))))
	 (area-exists       (and subarea (common:file-exists? subarea))))
    ;; (debug:print-info 0 *default-log-port* "Megatest subarea=" subarea ", area-exists=" area-exists)
    (if subarea
	(iup:frame 
	 #:title "Megatest Run Info" ; #:expand "YES"
	 (iup:button
	  "Launch Dashboard"
	  #:action (lambda (obj)
		     (system (conc "cd " subarea ";env -i PATH=$PATH DISPLAY=$DISPLAY HOME=$HOME USER=$USER dashboard &")))))
                     (subrun:launch-dashboard test-run-dir))))
	(iup:vbox))))

;; use a global for setting the buttons colors
;;                           state status teststeps
(define *state-status* (vector #f #f #f))
(define (update-state-status-buttons testdat)
  (let* ((state  (db:test-get-state  testdat))
︙

Modified dashboard.scm from [22bb220403] to [1c3c13f3a7].

︙
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44

30
31
32
33
34
35
36

37
38
39
40
41
42
43
44








-
+








(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses dashboard-guimonitor))
(declare (uses tree))
(declare (uses dcommon))
(declare (uses vg))

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

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
︙
2453
2454
2455
2456
2457
2458
2459









2460
2461
2462
2463
2464
2465
2466

2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475








+
+
+
+
+
+
+
+
+








      ;; (rmt:test-set-state-status-by-id run-id test-id "KILLREQ" #f #f)
      (common:run-a-command
       (conc "megatest -set-state-status KILLREQ,n/a -target " target
             " -runname " runname
             " -testpatt " item-test-path 
             " -state RUNNING,REMOTEHOSTSTART,LAUNCHED,NOT_STARTED"))))

   (let* ((rundir    (db:test-get-rundir      test-info))
          (has-subrun (subrun:subrun-test-initialized? rundir)))
       (if has-subrun
           (iup:menu-item
            "Launch subrun dashboard"
            #:action
            (lambda (obj)
              (subrun:launch-dashboard rundir)))
           (iup:vbox)))
   
   (iup:menu-item
    "Run"
    (iup:menu              
     (iup:menu-item
      (conc "Rerun " testpatt)
      #:action
︙
2565
2566
2567
2568
2569
2570
2571



2572
2573
2574
2575
2576
2577
2578

2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590








+
+
+








			   (get-environment-variable "EDITOR") "vi"))
	       (tconfig (conc (hash-table-ref all-tests test-name) "/testconfig"))
	       (cmd (conc (if (string-search editor-rx editor)
			      (conc "xterm -e " editor)
			      editor)
			  " " tconfig " &")))
	  (system cmd))))

     
     
     ))))

(define (make-dashboard-buttons commondat) ;;  runs-sum-dat new-view-dat)
  (let* ((stats-dat       (dboard:tabdat-make-data))
	 (runs-dat        (dboard:tabdat-make-data))
	 (onerun-dat      (dboard:tabdat-make-data)) ;; name for run-summary structure 
	 (runcontrols-dat (dboard:tabdat-make-data))
︙

Modified subrun.scm from [1505459fab] to [57664739f6].

︙
33
34
35
36
37
38
39






40
41
42
43
44
45
46

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52








+
+
+
+
+
+









(define (subrun:subrun-test-initialized? test-run-dir)
  (if (and (common:file-exists? (conc test-run-dir "/subrun-area") )
           (common:file-exists? (conc test-run-dir "/testconfig.subrun") ))
      #t
      #f))

(define (subrun:launch-dashboard test-run-dir)
  (if (subrun:subrun-test-initialized? test-run-dir)
      (let* ((subarea (subrun:get-runarea test-run-dir)))
        (if (and subarea (common:file-exists? subarea))
            (system (conc "cd " subarea ";env -i PATH=$PATH DISPLAY=$DISPLAY HOME=$HOME USER=$USER dashboard &"))))))

(define (subrun:subrun-removed? test-run-dir)
  (if (subrun:subrun-test-initialized? test-run-dir)
      (let ((flagfile (conc test-run-dir "/subrun.removed")))
        (if (common:file-exists? flagfile)
            #t
            #f))
      #t))
︙
98
99
100
101
102
103
104










105
106
107
108
109
110
111

104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127








+
+
+
+
+
+
+
+
+
+








  (let* ((log-prefix "run")
         (switches (subrun:selector+log-switches test-run-dir log-prefix))
         (run-wait #t)
         (cmd      (conc "megatest -run "switches" "
                         (if run-wait "-run-wait " ""))))
    cmd))


(define (subrun:get-runarea test-run-dir)
  (if (subrun:subrun-test-initialized? test-run-dir)
      (let* ((info-alist (subrun:selector+log-alist
                          test-run-dir
                          "foo"))
             (run-area   (if (list? info-alist)
                             (alist-ref "-start-dir" info-alist equal? #f)
                             #f)))
        run-area)))

(define (subrun:selector+log-alist test-run-dir log-prefix)
  (let* ((switch-def-alist (common:get-param-mapping flavor: 'config))
         (subrunfile   (conc test-run-dir "/testconfig.subrun" ))
         (subrundata   (with-input-from-file subrunfile read))
         (subrunconfig (configf:alist->config subrundata))
         (run-area     (configf:lookup subrunconfig "subrun" "run-area"))
︙

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