Megatest

Diff
Login

Differences From Artifact [99c3c82dba]:

To Artifact [33113834d2]:


29
30
31
32
33
34
35
36
37
38
39
40
41





















42
43
44
45

46
47
48
49
50
51
52
29
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
63
64
65
66
67







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



-
+







(define *db* #f) ;; this is only for the repl, do not use in general!!!!

(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)
;; (use trace dot-locking)
;; (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
;;  tests:summarize-items
;;  db:test-get-logfile-info
;;  obtain-dot-lock
;;  change-directory
;;  cdb:remote-run
;; )
       

(define help (conc "
Megatest, documentation at http://chiselapp.com/user/kiatoa/repository/megatest
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140







+







  -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
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229







+







		        "-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
317
318
319
320
321
322
323

324
325
326
327
328
329
330
331







-
+







	(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")))
		    (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
408
409
410
411
412
413
414

415
416
417
418
419
420
421
422







-
+







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