1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
-
+
|
;; Copyright 2006-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(include "common.scm")
(define megatest-version 1.11)
(define megatest-version 1.12)
(define help (conc "
Megatest, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright Matt Welland 2006-2011
Usage: megatest [options]
|
| ︙ | | |
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
+
+
|
Misc
-force : override some checks
-xterm : start an xterm instead of launching the test
-remove-runs : remove the data for a run, requires fields, :runname
and -testpatt
-testpatt patt : remove tests matching patt (requires -remove-runs)
-keepgoing : continue running until no jobs are \"LAUNCHED\" or
\"NOT_STARTED\"
Helpers
-runstep stepname ... : take remaining params as comand and execute as stepname
log will be in stepname.log. Best to put command in quotes
-logpro file : with -exec apply logpro file to stepname.log, creates
stepname.html and sets log to same
If using make use stepname_logpro.log as your target
|
| ︙ | | |
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
+
|
"-force"
"-xterm"
"-showkeys"
"-test-status"
"-gui"
"-runall" ;; run all tests
"-remove-runs"
"-keepgoing"
)
args:arg-hash
0))
(if (args:get-arg "-h")
(begin
(print help)
|
| ︙ | | |
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
|
-
+
|
(print "ERROR: Attempted to run a test but run area config file not found")
(exit 1))
;; put test parameters into convenient variables
(let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now
(print "INFO: Attempting to start the following tests...")
(print " " (string-intersperse test-names ","))
(run-tests db test-names)))
(run-waiting-tests db)
;; (run-waiting-tests db)
(sqlite3:finalize! db)
(set! *didsomething* #t))))
;;======================================================================
;; run one test
;;======================================================================
|
| ︙ | | |
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
|
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
-
+
|
(print "ERROR: Attempted to run a test but run area config file not found")
(exit 1))
;; put test parameters into convenient variables
(let* ((test-names (string-split (args:get-arg "-runtests") ",")))
(run-tests db test-names)))
;; run-waiting-tests db)
(sqlite3:finalize! db)
(run-waiting-tests #f)
;; (run-waiting-tests #f)
(set! *didsomething* #t))))
(if (args:get-arg "-runtests")
(runtests))
;;======================================================================
;; execute the test
|
| ︙ | | |
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
|
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
|
+
+
-
+
+
+
+
+
+
|
(-
(current-seconds)
start-seconds))))))
(let loop ((minutes (calc-minutes)))
(let ((db (open-db)))
(set! kill-job? (test-get-kill-request db run-id test-name itemdat))
(test-update-meta-info db run-id test-name itemdat minutes)
(if kill-job?
(begin
(if kill-job? (process-signal (vector-ref exit-info 0) signal/term))
(process-signal (vector-ref exit-info 0) signal/term)
(sleep 2)
(handle-exceptions
exn
(print "ERROR: Problem killing process " (vector-ref exit-info 0))
(process-signal (vector-ref exit-info 0) signal/kill))))
(sqlite3:finalize! db)
(thread-sleep! (+ 8 (random 4))) ;; add some jitter to the call home time to spread out the db accesses
(loop (calc-minutes)))))))
(th1 (make-thread monitorjob))
(th2 (make-thread runit)))
(thread-start! th1)
(thread-start! th2)
|
| ︙ | | |
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
|
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
|
-
+
|
(redir (case (string->symbol shell)
((tcsh csh ksh) ">&")
((zsh bash sh ash) "2>&1 >")))
(fullcmd (conc "(" (string-intersperse
(cons cmd params) " ")
") " redir " " logfile)))
;; mark the start of the test
(test-set-status! db run-id test-name "start" "n/a" itemdat (args:get-arg "-m"))
(teststep-set-status! db run-id test-name stepname "start" "n/a" itemdat (args:get-arg "-m"))
;; close the db
(sqlite3:finalize! db)
;; run the test step
(print "INFO: Running \"" fullcmd "\"")
(change-directory startingdir)
(set! exitstat (system fullcmd)) ;; cmd params))
(set! *globalexitstatus* exitstat)
|
| ︙ | | |