| ︙ | | | ︙ | |
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")
;; (use trace)
;; (trace db:teststep-set-status!
;; tests:test-set-status!
;; cdb:test-set-status-state
;; cdb:client-call
;; tests:check-waiver-eligibility)
(define help (conc "
Megatest, documentation at http://chiselapp.com/user/kiatoa/repository/megatest
version " megatest-version "
license GPL, Copyright Matt Welland 2006-2012
Usage: megatest [options]
-h : this help
-version : print megatest version (currently " megatest-version ")
|
>
>
>
>
>
>
>
>
>
|
|
|
|
|
>
|
|
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")
;; (use trace)
;; (trace
;; thread-sleep!
;; sqlite3:execute
;; sqlite3:for-each-row
;; open-run-close
;; runs:can-run-more-tests
;; cdb:remote-run
;; nice-path
;; read-config
;; db:teststep-set-status!
;; tests:test-set-status!
;; cdb:test-set-status-state
;; cdb:client-call
;; tests:check-waiver-eligibility
;; )
(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 ")
|
| ︙ | | | ︙ | |
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
-update-meta : update the tests metadata for all tests
-env2file fname : write the environment to fname.csh and fname.sh
-setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
overwritten by values set in config files.
-server -|hostname : start the server (reduces contention on megatest.db), use
- to automatically figure out hostname
-transport http|zmq : use http or zmq for transport (default is http)
-list-servers : list the servers
-repl : start a repl (useful for extending megatest)
-load file.scm : load and run file.scm
Spreadsheet generation
-extract-ods fname.ods : extract an open document spreadsheet from the database
-pathmod path : insert path, i.e. path/runame/itempath/logfile.html
|
>
|
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
-update-meta : update the tests metadata for all tests
-env2file fname : write the environment to fname.csh and fname.sh
-setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
overwritten by values set in config files.
-server -|hostname : start the server (reduces contention on megatest.db), use
- to automatically figure out hostname
-transport http|zmq : use http or zmq for transport (default is http)
-daemonize : fork into background and disconnect from stdin/out
-list-servers : list the servers
-repl : start a repl (useful for extending megatest)
-load file.scm : load and run file.scm
Spreadsheet generation
-extract-ods fname.ods : extract an open document spreadsheet from the database
-pathmod path : insert path, i.e. path/runame/itempath/logfile.html
|
| ︙ | | | ︙ | |
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
"-xterm"
"-showkeys"
"-test-status"
"-set-values"
"-load-test-data"
"-summarize-items"
"-gui"
;; misc
"-archive"
"-repl"
"-lock"
"-unlock"
"-list-servers"
;; mist queries
|
>
|
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
"-xterm"
"-showkeys"
"-test-status"
"-set-values"
"-load-test-data"
"-summarize-items"
"-gui"
"-daemonize"
;; misc
"-archive"
"-repl"
"-lock"
"-unlock"
"-list-servers"
;; mist queries
|
| ︙ | | | ︙ | |
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
|
(if (setup-for-run)
(let ((servers (open-run-close tasks:get-best-server tasks:open-db)))
(if (or (not servers)
(null? servers))
(begin
(debug:print 0 "INFO: Starting server as none running ...")
;; (server:launch (string->symbol (args:get-arg "-transport" "http"))))
(system (conc (car (argv)) " -server - -transport " (args:get-arg "-transport" "http")))
(thread-sleep! 3)) ;; give the server a few seconds to start
(debug:print 0 "INFO: Servers already running " servers)
)))))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
|
|
|
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
(if (setup-for-run)
(let ((servers (open-run-close tasks:get-best-server tasks:open-db)))
(if (or (not servers)
(null? servers))
(begin
(debug:print 0 "INFO: Starting server as none running ...")
;; (server:launch (string->symbol (args:get-arg "-transport" "http"))))
(system (conc (car (argv)) " -server - -daemonize -transport " (args:get-arg "-transport" "http")))
(thread-sleep! 3)) ;; give the server a few seconds to start
(debug:print 0 "INFO: Servers already running " servers)
)))))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
|
| ︙ | | | ︙ | |
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
|
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
(else
(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
(set! *didsomething* #t)))
(if (args:get-arg "-show-config")
(let ((data (read-config "megatest.config" #f #t)))
;; keep this one local
(cond
((not (args:get-arg "-dumpmode"))
(pp (hash-table->alist data)))
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
(else
|
|
|
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
|
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
(else
(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
(set! *didsomething* #t)))
(if (args:get-arg "-show-config")
(let ((data *configdat*)) ;; (read-config "megatest.config" #f #t)))
;; keep this one local
(cond
((not (args:get-arg "-dumpmode"))
(pp (hash-table->alist data)))
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
(else
|
| ︙ | | | ︙ | |