| ︙ | | |
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
|
+
|
(define help (conc "
Megatest, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright Matt Welland 2006-2012
Usage: megatest [options]
-h : this help
-version : print megatest version (currently " megatest-version ")
Launching and managing runs
-runall : run all tests that are not state COMPLETED and status PASS,
CHECK or KILLED
-runtests tst1,tst2 ... : run tests
-remove-runs : remove the data for a run, requires :runname and -testpatt
Optionally use :state and :status
|
| ︙ | | |
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
+
|
"-set-state-status"
"-debug" ;; for *verbosity* > 2
"-gen-megatest-test"
"-override-timeout"
"-test-files" ;; -test-paths is for listing all
)
(list "-h"
"-version"
"-force"
"-xterm"
"-showkeys"
"-test-status"
"-set-values"
"-load-test-data"
"-summarize-items"
|
| ︙ | | |
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
|
+
+
+
+
+
-
+
-
-
+
-
-
-
-
-
-
-
-
+
|
args:arg-hash
0))
(if (args:get-arg "-h")
(begin
(print help)
(exit)))
(if (args:get-arg "-version")
(begin
(print megatest-version)
(exit)))
(define *didsomething* #f)
;;======================================================================
;; Misc setup stuff
;;======================================================================
(set! *verbosity* (cond
(set! *verbosity* (debug:calc-verbosity (args:get-arg "-debug")))
((string? (args:get-arg "-debug"))(string->number (args:get-arg "-debug")))
((args:get-arg "-v") 2)
((args:get-arg "-q") 0)
(else 1)))
(if (not (number? *verbosity*))
(begin
(print "ERROR: Invalid debug value " (args:get-arg "-debug"))
(exit)))
(if (> *verbosity* 3) ;; we are obviously debugging
(if (debug:debug-mode 3) ;; we are obviously debugging
(set! open-run-close open-run-close-no-exception-handling))
;; a,b,c % => a/%,b/%,c/%
(define (tack-on-patt srcstr patt)
(let ((strlst (string-split srcstr ",")))
(string-intersperse
(map (lambda (str)
|
| ︙ | | |
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
|
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
|
-
+
|
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;;======================================================================
(if (args:get-arg "-server")
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(debug:print 0 "INFO: Starting the standalone server")
(debug:print-info 0 "Starting the standalone server")
(if db
(let* ((host:port (db:get-var db "SERVER")) ;; this doen't support multiple servers BUG!!!!
(th2 (server:start db (args:get-arg "-server")))
(th3 (make-thread (lambda ()
(server:keep-running db host:port)))))
(thread-start! th3)
(thread-join! th3)
|
| ︙ | | |
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
|
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
|
-
+
-
+
|
(else ">&")))
(fullcmd (conc "(" (string-intersperse
(cons cmd params) " ")
") " redir " " logfile)))
;; mark the start of the test
(open-run-close db:teststep-set-status! db test-id stepname "start" "n/a" (args:get-arg "-m") logfile)
;; run the test step
(debug:print 2 "INFO: Running \"" fullcmd "\"")
(debug:print-info 2 "Running \"" fullcmd "\"")
(change-directory startingdir)
(set! exitstat (system fullcmd)) ;; cmd params))
(set! *globalexitstatus* exitstat)
(change-directory testpath)
;; run logpro if applicable ;; (process-run "ls" (list "/foo" "2>&1" "blah.log"))
(if logprofile
(let* ((htmllogfile (conc stepname ".html"))
(oldexitstat exitstat)
(cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
(debug:print 2 "INFO: running \"" cmd "\"")
(debug:print-info 2 "running \"" cmd "\"")
(change-directory startingdir)
(set! exitstat (system cmd))
(set! *globalexitstatus* exitstat) ;; no necessary
(change-directory testpath)
(open-run-close db:test-set-log! db test-id htmllogfile)))
(let ((msg (args:get-arg "-m")))
(open-run-close db:teststep-set-status! db test-id stepname "end" exitstat msg logfile))
|
| ︙ | | |