Megatest

Diff
Login

Differences From Artifact [d65587d64a]:

To Artifact [6be51f628a]:


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
(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
 thread-sleep!





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








|
|
|
>
>
>
>
>







<
>







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

116
117
118
119
120
121
122

123
124
125
126
127
128
129
  -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
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
	(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"))







|







311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
	(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"))