Megatest

Check-in [5fc417f195]
Login
Overview
Comment:Converted runsdir to linktree, tweaked new gui for looks
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5fc417f1955dc98bfd304e9fb50712b8e0c92d1b
User & Date: matt on 2011-11-28 07:48:48
Other Links: manifest | tags
Context
2011-12-04
21:56
Added test for logpro required regression and some tweaks to dashboard look 'n feel check-in: 3c70848db0 user: matt tags: trunk
2011-11-28
07:48
Converted runsdir to linktree, tweaked new gui for looks check-in: 5fc417f195 user: matt tags: trunk
2011-11-27
23:39
Initial megatest.config gui based editor stuff in place check-in: b7ca8cbac9 user: matt tags: trunk
Changes

Modified configf.scm from [b0a9c60c64] to [b844677094].

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104





















105
106
107
108
109
110
111
78
79
80
81
82
83
84




















85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112







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







	       (configf:comment-rx _                  (loop (read-line inp) curr-section-name #f #f))
	       (configf:blank-l-rx _                  (loop (read-line inp) curr-section-name #f #f))
	       (configf:include-rx ( x include-file ) (begin
						(read-config include-file res allow-system environ-patt: environ-patt)
						(loop (read-line inp) curr-section-name #f #f)))
	       (configf:section-rx ( x section-name ) (loop (read-line inp) section-name #f #f))
	       (configf:key-sys-pr ( x key cmd      ) (if allow-system
						  (let ((alist (hash-table-ref/default res curr-section-name '()))
							(val-proc (lambda ()
								    (let* ((cmdres  (cmd-run->list cmd))
									   (status  (cadr cmdres))
									   (res     (car  cmdres)))
								      (if (not (eq? status 0))
									  (begin
									    (debug:print 0 "ERROR: problem with " inl ", return code " status)
									    (exit 1)))
								      (if (null? res)
									  ""
									  (string-intersperse res " "))))))
						    (hash-table-set! res curr-section-name 
								     (config:assoc-safe-add alist
											    key 
											    (if (eq? allow-system 'return-procs)
												val-proc
												(val-proc))))
						    (loop (read-line inp) curr-section-name #f #f))
						  (loop (read-line inp) curr-section-name #f #f)))
							  (let ((alist (hash-table-ref/default res curr-section-name '()))
								(val-proc (lambda ()
									    (let* ((cmdres  (cmd-run->list cmd))
										   (status  (cadr cmdres))
										   (res     (car  cmdres)))
									      (if (not (eq? status 0))
										  (begin
										    (debug:print 0 "ERROR: problem with " inl ", return code " status)
										    (exit 1)))
									      (if (null? res)
										  ""
										  (string-intersperse res " "))))))
							    (hash-table-set! res curr-section-name 
									     (config:assoc-safe-add alist
												    key 
												    (case allow-system
												      ((return-procs) val-proc)
												      ((return-string) cmd)
												      (else (val-proc)))))
							    (loop (read-line inp) curr-section-name #f #f))
							  (loop (read-line inp) curr-section-name #f #f)))
	       (configf:key-val-pr ( x key val      ) (let* ((alist   (hash-table-ref/default res curr-section-name '()))
						     (envar   (and environ-patt (string-match (regexp environ-patt) curr-section-name)))
						     (realval (if envar
								 (config:eval-string-in-environment val)
								 val)))
						(if envar
						    (begin

Modified dashboard-main.scm from [9d2339fc92] to [2412bd6109].

53
54
55
56
57
58
59
60

61
62
63
64
65
66
67
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67







-
+







		       ))))


(define (mtest)
  (let* ((curr-row-num     0)
	 (rawconfig        (read-config (conc *toppath* "/megatest.config") #f 'return-string))
	 (keys-matrix      (iup:matrix
		            #:expand "YES"
		            #:expand "VERTICAL"
		            ;; #:scrollbar "YES"
		            #:numcol 1
		            #:numlin 20
		            #:numcol-visible 1
		            #:numlin-visible 5
		            #:click-cb (lambda (obj lin col status)
					 (print "obj: " obj " lin: " lin " col: " col " status: " status))))
76
77
78
79
80
81
82
83

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103


104
105

106
107
108
109


110
111
112
113
114
115
116
76
77
78
79
80
81
82

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99




100
101


102




103
104
105
106
107
108
109
110
111







-
+
















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







			    #:numcol 1
			    #:numlin 5
			    #:numcol-visible 1
			    #:numlin-visible 3))
	 (validvals-matrix (iup:matrix
			    #:expand "YES"
			    #:numcol 1
			    #:numlin 5
			    #:numlin 2
			    #:numcol-visible 1
			    #:numlin-visible 2))
	 (envovrd-matrix   (iup:matrix
			    #:expand "YES"
			    #:numcol 1
			    #:numlin 20
			    #:numcol-visible 1
			    #:numlin-visible 8))
	 (disks-matrix     (iup:matrix
			    #:expand "YES"
			    #:numcol 1
			    #:numlin 20
			    #:numcol-visible 1
			    #:numlin-visible 8)))
    (iup:attribute-set! keys-matrix "0:0" "Field Num")
    (iup:attribute-set! keys-matrix "0:1" "Field Name")
    (for-each
     (lambda (mat)
       (iup:attribute-set! mat "0:1" "Value")
       (iup:attribute-set! mat "0:0" "Var")
    (iup:attribute-set! keys-matrix "WIDTH1" "100")
    (iup:attribute-set! disks-matrix "0:0" "Disk Name")
       (iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
       (iup:attribute-set! mat "FIXTOTEXT" "C1")
    (iup:attribute-set! disks-matrix "0:1" "Disk Path")
       (iup:attribute-set! mat "RESIZEMATRIX" "YES"))
     (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix))
    (iup:attribute-set! disks-matrix "0:0" "Disk Name")
    (iup:attribute-set! disks-matrix "0:1" "Disk Path")
    (iup:attribute-set! disks-matrix "WIDTH1" "120")
    (iup:attribute-set! disks-matrix "WIDTH0" "100")
    (iup:attribute-set! disks-matrix "ALIGNMENT1" "ALEFT")
    (iup:attribute-set! disks-matrix "FIXTOTEXT" "C1")
    (iup:attribute-set! disks-matrix "RESIZEMATRIX" "YES")
    ;; fill in keys
    (set! curr-row-num 1)
    (for-each 
     (lambda (var)
128
129
130
131
132
133
134












135
136
137
138
139
140









141



142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158


















159
160
161
162







163
164
165
166
167
168
169
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143




144
145
146
147
148
149
150
151
152
153
154
155
156

















157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174




175
176
177
178
179
180
181
182
183
184
185
186
187
188







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


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

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







	  (iup:attribute-set! mat (conc curr-row-num ":0") var)
	  (iup:attribute-set! mat (conc curr-row-num ":1") (config-lookup rawconfig fname var))
	  (set! curr-row-num (+ curr-row-num 1)))
	(configf:section-vars rawconfig fname)))
     (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix disks-matrix)
     (list "setup"      "jobtools"      "validvalues"      "env-override" "disks"))

    (for-each
     (lambda (mat)
       (iup:attribute-set! mat "0:1" "Value")
       (iup:attribute-set! mat "0:0" "Var")
       (iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
       (iup:attribute-set! mat "FIXTOTEXT" "C1")
       (iup:attribute-set! mat "RESIZEMATRIX" "YES")
       (iup:attribute-set! mat "WIDTH1" "120")
       (iup:attribute-set! mat "WIDTH0" "100")
       )
     (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix))

    (iup:vbox
     (iup:hbox
      ;; The keys
      (iup:frame 
       #:title "Keys"
       keys-matrix)
       ;; The keys
       (iup:frame 
	#:title "Keys (required)"
	(iup:vbox
	 (iup:label (conc "Set the fields for organising your runs\n"
			  "here. Note: can only be changed before\n"
			  "running the first run when megatest.db\n"
			  "is created."))
	 keys-matrix))
      (iup:vbox
       (let ((tabs (iup:tabs 
		    ;; The required tab
		    (iup:vbox
       ;; The setup section
       (iup:frame
	#:title "Setup"
	setup-matrix)
       ;; The jobtools
       (iup:frame
	#:title "Jobtools"
	jobtools-matrix)
       ;; The valid values
       (iup:frame
	#:title "Validvalues"
	validvals-matrix))
      (iup:vbox
       ;; The Environment Overrides
       (iup:frame 
	#:title "Env override"
	envovrd-matrix)
		     ;; The setup section
		     (iup:frame
		      #:title "Setup"
		      setup-matrix)
		     ;; The jobtools
		     (iup:frame
		      #:title "Jobtools"
		      jobtools-matrix)
		     ;; The valid values
		     ;; The disks
		     (iup:frame
		      #:title "Disks"
		      disks-matrix))
		    (iup:vbox
		     ;; The Environment Overrides
		     (iup:frame 
		      #:title "Env override"
		      envovrd-matrix)
       ;; The disks
       (iup:frame
	#:title "Disks"
	disks-matrix))
		     (iup:frame
		      #:title "Validvalues"
		      validvals-matrix)
		     ))))
	 (iup:attribute-set! tabs "TABTITLE0" "Required settings")
	 (iup:attribute-set! tabs "TABTITLE1" "Optional settings")
	 tabs))
       ))))

(define (rconfig)
  (iup:vbox
   (iup:frame #:title "Default")))

(define (tests)

Modified launch.scm from [a9c8f38913] to [de874bb868].

369
370
371
372
373
374
375
376

377
378
379


380
381
382


383
384
385
386
387
388
389
369
370
371
372
373
374
375

376
377


378
379
380


381
382
383
384
385
386
387
388
389







-
+

-
-
+
+

-
-
+
+







					   (db:get-header run-info)
					   "runname"))
	 (key-vals (get-key-vals db run-id))
	 (key-str  (string-intersperse key-vals "/"))
	 (dfullp   (conc disk-path "/" key-str "/" runname "/" testname
			 item-path))
	 (toptest-path (conc disk-path "/" key-str "/" runname "/" testname))
	 (runsdir  (let ((rd (config-lookup *configdat* "setup" "runsdir")))
	 (linktree  (let ((rd (config-lookup *configdat* "setup" "linktree")))
		     (if rd rd (conc *toppath* "/runs"))))
	 (lnkpath  (conc runsdir "/" key-str "/" runname item-path)))
    (if (not (file-exists? runsdir))
	 (lnkpath  (conc linktree "/" key-str "/" runname item-path)))
    (if (not (file-exists? linktree))
	(begin
	  (debug:print 0 "WARNING: runsdir did not exist! Creating it now at " runsdir)
	  (system (conc "mkdir -p " runsdir))))
	  (debug:print 0 "WARNING: linktree did not exist! Creating it now at " linktree)
	  (system (conc "mkdir -p " linktree))))
    ;; since this is an iterated test this is as good a place as any to
    ;; update the toptest record with its location rundir
    (if (not (equal? item-path ""))
	(db:test-set-rundir! db run-id testname "" toptest-path))
    (debug:print 2 "Setting up test run area")
    (debug:print 2 " - creating run area in " dfullp)
    (system  (conc "mkdir -p " dfullp))

Modified tests/megatest.config from [9748b106ce] to [15ea3d69a8].

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16








-
+







[fields]
sysname TEXT
fsname TEXT
datapath TEXT

[setup]
# exectutable /path/to/megatest
max_concurrent_jobs 50
runsdir /tmp/runs
linktree /tmp/runs

[jobtools]
# useshell yes
# ## launcher launches jobs, the job is managed on the target host
## by megatest, comment out launcher to run local
# workhosts localhost hermes
launcher nbfake