Megatest

Check-in [5fc417f195]
Login
☰Home Timeline Files Branches Tags Tickets Wiki 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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

	       (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)))
	       (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








|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|








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 
												    (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

		       ))))


(define (mtest)
  (let* ((curr-row-num     0)
	 (rawconfig        (read-config (conc *toppath* "/megatest.config") #f 'return-string))
	 (keys-matrix      (iup:matrix
		            #:expand "YES"
		            ;; #: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))))








|








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 "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

			    #:numcol 1
			    #:numlin 5
			    #:numcol-visible 1
			    #:numlin-visible 3))
	 (validvals-matrix (iup:matrix
			    #:expand "YES"
			    #:numcol 1
			    #:numlin 5
			    #: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! mat "ALIGNMENT1" "ALEFT")
       (iup:attribute-set! mat "FIXTOTEXT" "C1")
       (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 "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)








|
















<
<
|
|
<
|
<
<
|
|








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 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")


    (iup:attribute-set! keys-matrix "WIDTH1" "100")
    (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

	  (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"))













    (iup:vbox
     (iup:hbox
      ;; The keys
      (iup:frame 
       #:title "Keys"





       keys-matrix)
      (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 disks
       (iup:frame
	#:title "Disks"
	disks-matrix))




       ))))

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

(define (tests)








>
>
>
>
>
>
>
>
>
>
>
>


|
|
|
>
>
>
>
>
|

>
>
>
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
<
|
|
|
>
>
>
>








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 (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
		     ;; The disks
		     (iup:frame
		      #:title "Disks"
		      disks-matrix))
		    (iup:vbox
		     ;; The Environment Overrides
		     (iup:frame 
		      #:title "Env override"
		      envovrd-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

					   (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")))
		     (if rd rd (conc *toppath* "/runs"))))
	 (lnkpath  (conc runsdir "/" key-str "/" runname item-path)))
    (if (not (file-exists? runsdir))
	(begin
	  (debug:print 0 "WARNING: runsdir did not exist! Creating it now at " runsdir)
	  (system (conc "mkdir -p " runsdir))))
    ;; 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))








|

|
|

|
|








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))
	 (linktree  (let ((rd (config-lookup *configdat* "setup" "linktree")))
		     (if rd rd (conc *toppath* "/runs"))))
	 (lnkpath  (conc linktree "/" key-str "/" runname item-path)))
    (if (not (file-exists? linktree))
	(begin
	  (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

[fields]
sysname TEXT
fsname TEXT
datapath TEXT

[setup]
# exectutable /path/to/megatest
max_concurrent_jobs 50
runsdir /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









|








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
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
︙︙

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