| ︙ | | |
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
+
|
(declare (uses daemon))
(declare (uses db))
(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(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 "run_records.scm")
|
| ︙ | | |
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
+
|
-load file.scm : load and run file.scm
-mark-incompletes : find and mark incomplete tests
-ping run-id|host:port : ping server, exit with 0 if found
-debug N|N,M,O... : enable debug 0-N or N and M and O ...
Utilities
-env2file fname : write the environment to fname.csh and fname.sh
-envcap fname=context : save current variables labeled as context in file fname
-refdb2dat refdb : convert refdb to sexp or to format specified by -dumpmode
formats: perl, ruby, sqlite3, csv (for csv the -o param
will substitute %s for the sheet name in generating
multiple sheets)
-o : output file for refdb2dat (defaults to stdout)
-archive cmd : archive runs specified by selectors to one of disks specified
in the [archive-disks] section.
|
| ︙ | | |
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
+
|
"-stop-server"
"-transport"
"-kill-server"
"-port"
"-extract-ods"
"-pathmod"
"-env2file"
"-envcap"
"-setvars"
"-set-state-status"
"-set-run-status"
"-debug" ;; for *verbosity* > 2
"-gen-megatest-test"
"-override-timeout"
"-test-files" ;; -test-paths is for listing all
|
| ︙ | | |
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
|
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
|
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(let ((tl (launch:setup-for-run))
(run-id (and (args:get-arg "-run-id")
(string->number (args:get-arg "-run-id")))))
(if run-id
(begin
(server:launch run-id)
(set! *didsomething* #t))
(debug:print 0 "ERROR: server requires run-id be specified with -run-id")))
(debug:print 0 "ERROR: server requires run-id be specified with -run-id"))))
;; Not a server? This section will decide how to communicate
;;
;; Setup client for all expect listed here
(if (null? (lset-intersection
equal?
(hash-table-keys args:arg-hash)
'("-list-servers"
"-stop-server"
"-show-cmdinfo"
"-list-runs"
"-ping")))
(if (launch:setup-for-run)
(let ((run-id (and (args:get-arg "-run-id")
(string->number (args:get-arg "-run-id")))))
;; (set! *fdb* (filedb:open-db (conc *toppath* "/db/paths.db")))
;; if not list or kill then start a client (if appropriate)
(if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "Server connection not needed")
(begin
;; (if run-id
;; (client:launch run-id)
;; (client:launch 0) ;; without run-id we'll start a server for "0"
#t
))))))
;; (if (null? (lset-intersection
;; equal?
;; (hash-table-keys args:arg-hash)
;; '("-list-servers"
;; "-stop-server"
;; "-show-cmdinfo"
;; "-list-runs"
;; "-ping")))
;; (if (launch:setup-for-run)
;; (let ((run-id (and (args:get-arg "-run-id")
;; (string->number (args:get-arg "-run-id")))))
;; ;; (set! *fdb* (filedb:open-db (conc *toppath* "/db/paths.db")))
;; ;; if not list or kill then start a client (if appropriate)
;; (if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
;; (eq? (length (hash-table-keys args:arg-hash)) 0))
;; (debug:print-info 1 "Server connection not needed")
;; (begin
;; ;; (if run-id
;; ;; (client:launch run-id)
;; ;; (client:launch 0) ;; without run-id we'll start a server for "0"
;; #t
;; ))))))
;; MAY STILL NEED THIS
;; (set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-stop-server"))
(let ((tl (launch:setup-for-run)))
|
| ︙ | | |
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
|
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(if (args:get-arg "-sync-to-megatest.db")
(begin
(db:multi-db-sync
#f ;; do all run-ids
'new2old
)
(set! *didsomething* #t)))
;;======================================================================
;; Capture, save and manipulate environments
;;======================================================================
(let ((envcap (args:get-arg "-envcap")))
(if envcap
(if (substring-index "=" envcap)
(let* ((parts (string-split envcap "="))
(fname (car parts))
(context (cadr parts))
(db (env:open-db fname)))
(env:save-env-vars db context)
(env:close-database db)
(set! *didsomething* #t))
(begin
(debug:print 0 "ERROR: Parameter to -envcap should be <filename>=<context>. E.G. envdat=original, got: " envcap)
(set! *didsomething* #t)))))
;;======================================================================
;; Exit and clean up
;;======================================================================
(if *runremote* (close-all-connections!))
|
| ︙ | | |