Megatest

Check-in [4c81f4b156]
Login
Overview
Comment:Split off pre and post commands in dashboard test control panel system calls with override from config
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: 4c81f4b15691f25786bf939388d37cc7393f4ee6
User & Date: mrwellan on 2014-05-30 09:50:08
Other Links: branch diff | manifest | tags
Context
2014-05-30
12:21
Added -preclean, bumped version check-in: 3ccb5eb517 user: mrwellan tags: v1.55, v1.5521
09:50
Split off pre and post commands in dashboard test control panel system calls with override from config check-in: 4c81f4b156 user: mrwellan tags: v1.55
09:00
Moved call to run-wait to a point after all other likely calls so that run wait can be used with other switches. Added blocking of remove whne a test has sub tests. check-in: 95dcd86380 user: mrwellan tags: v1.55
Changes

Modified dashboard-tests.scm from [a6f9ebb846] to [febf7aa257].

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
42
43
44
45
46
47
48
49
50
51
52
53







+
+
+
+
+
+
+
+
+
+
+
+
+







(declare (uses db))
(declare (uses gutils))
(declare (uses ezsteps))

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

;;======================================================================
;; C O M M O N
;;======================================================================

(define (dtests:get-pre-command #!key (default-override #f))
  (let ((cfg-ovrd (configf:lookup *configdat* "dashboard" "pre-command")))
    (or cfg-ovrd default-override "xterm -geometry 180x20 -e \"")))

(define (dtests:get-post-command #!key (default-override #f))
  (let ((cfg-ovrd (configf:lookup *configdat* "dashboard" "post-command")))
    (or cfg-ovrd default-override ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))


(define (test-info-panel testdat store-label widgets)
  (iup:frame 
   #:title "Test Info" ; #:expand "YES"
   (iup:hbox ; #:expand "YES"
    (apply iup:vbox ; #:expand "YES"
	   (append (map (lambda (val)
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
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
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







-
-
+
+
+
+
+
+



-
+

-
-
+



-
+



-
+



-
+



-
+

-
-
+







-
+




-
+



-
+







							 (iup:attribute-set! lbl "TITLE" newval)
					;(mutex-unlock! mx1)
							 )))))
			      lbl))
	       (store-button store-label)
	       (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10"))
	       (command-launch-button (iup:button "Execute!" #:action (lambda (x)
									(let ((cmd (iup:attribute command-text-box "VALUE")))
									  (system (conc cmd "  &"))))))
									(let* ((cmd     (iup:attribute command-text-box "VALUE"))
									       (fullcmd (conc (dtests:get-pre-command)
											      cmd 
											      (dtests:get-post-command))))
									  (debug:print-info 0 "Running command: " fullcmd)
									  (system fullcmd)))))
	       (kill-jobs (lambda (x)
			    (iup:attribute-set! 
			     command-text-box "VALUE"
			     (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " -runname "  runname 
			     (conc "megatest -target " keystring " -runname "  runname 
				   " -set-state-status KILLREQ,n/a -testpatt %/% "
				   ;; (conc testname "/" (if (equal? item-path "") "%" item-path))
				   " -state RUNNING ;echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
				   " -state RUNNING"))))
	       (run-test  (lambda (x)
			    (iup:attribute-set! 
			     command-text-box "VALUE"
			     (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " -runname " runname 
			     (conc "megatest -target " keystring " -runname " runname 
				   " -runtests " (conc testname "/" (if (equal? item-path "")
									"%" 
									item-path))
				   " ;echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
				   ))))
	       (remove-test (lambda (x)
			      (iup:attribute-set!
			       command-text-box "VALUE"
			       (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " -runname " runname
			       (conc "megatest -remove-runs -target " keystring " -runname " runname
				     " -testpatt " (conc testname "/" (if (equal? item-path "")
									  "%"
									  item-path))
				     " -v ;echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
				     " -v"))))
	       (clean-run-execute  (lambda (x)
				     (let ((cmd (conc "xterm -geometry 180x20 -e \""
						      "megatest -remove-runs -target " keystring " -runname " runname
				     (let ((cmd (conc "megatest -remove-runs -target " keystring " -runname " runname
						      " -testpatt " (conc testname "/" (if (equal? item-path "")
											   "%"
											   item-path))
						      ";megatest -target " keystring " -runname " runname 
						      " -runtests " (conc testname "/" (if (equal? item-path "")
											   "%" 
											   item-path))
						      " ;echo Press any key to continue;bash -c 'read -n 1 -s'\"")))
						      )))
				       (system (conc cmd " &")))))
	       (remove-test (lambda (x)
			      (iup:attribute-set!
			       command-text-box "VALUE"
			       (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " -runname " runname
			       (conc "megatest -remove-runs -target " keystring " -runname " runname
				     " -testpatt " (conc testname "/" (if (equal? item-path "")
									  "%"
									  item-path))
				     " -v ;echo Press any key to continue;bash -c 'read -n 1 -s'\""))
				     " -v"))
			      )))
	  (cond
	   ((not testdat)(begin (print "ERROR: bad test info for " test-id)(exit 1)))
	   ((not rundat)(begin (print "ERROR: found test info but there is a problem with the run info for " run-id)(exit 1)))
	   (else
	    ;;  (test-set-status! db run-id test-name state status itemdat)
	    (set! self ; 

Modified tests/fullrun/megatest.config from [d34de12963] to [a41eca94b2].

1
2
3
4
5
6
7
8
9
10
11
12




13
14
15
16
17
18
19
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23












+
+
+
+







[fields]
sysname TEXT
fsname TEXT
datapath TEXT

# refareas can be searched to find previous runs
# the path points to where megatest.db exists
[refareas]
area1 /tmp/oldarea/megatest

[include config/mt_include_1.config]

[dashboard]
pre-command  xterm -geometry 180x20 -e "
post-command |& tee results.log ;echo Press any key to continue;bash -c 'read -n 1 -s'" &

[misc]
home #{shell readlink -f $MT_RUN_AREA_HOME}
parent #{shell readlink -f $MT_RUN_AREA_HOME/..}

[tests-paths]
1 #{get misc parent}/simplerun/tests