845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
|
(with-output-to-file
(args:get-arg "-o")
(lambda ()
(env:print added removed changed)))
(env:print added removed changed))
(env:close-database db)
(set! *didsomething* #t))
(debug:print-error 0 *default-log-port* "Parameter to -envdelta should be new=star-end")))))
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
;; Server? Start up here.
|
|
|
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
|
(with-output-to-file
(args:get-arg "-o")
(lambda ()
(env:print added removed changed)))
(env:print added removed changed))
(env:close-database db)
(set! *didsomething* #t))
(debug:print-error 0 *default-log-port* "Parameter to -envdelta should be new=start-end")))))
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
;; Server? Start up here.
|
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
|
((and (args:get-arg "-section")
(args:get-arg "-var"))
(let ((val (configf:lookup data (args:get-arg "-section")(args:get-arg "-var"))))
(if val (print val))))
;; print just a section if only -section
((not (args:get-arg "-dumpmode"))
(pp (hash-table->alist data)))
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
((string=? (args:get-arg "-dumpmode") "ini")
(configf:config->ini data))
(else
(debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
(set! *didsomething* #t)
(pop-directory)
(set! *time-to-exit* #t)))
|
|
|
>
|
|
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
|
((and (args:get-arg "-section")
(args:get-arg "-var"))
(let ((val (configf:lookup data (args:get-arg "-section")(args:get-arg "-var"))))
(if val (print val))))
;; print just a section if only -section
((equal? (args:get-arg "-dumpmode") "sexp")
(pp (hash-table->alist data)))
((equal? (args:get-arg "-dumpmode") "json")
(json-write data))
((or (not (args:get-arg "-dumpmode"))
(string=? (args:get-arg "-dumpmode") "ini"))
(configf:config->ini data))
(else
(debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
(set! *didsomething* #t)
(pop-directory)
(set! *time-to-exit* #t)))
|
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
|
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;; state: states
status: #f
new-state-status: "NOT_STARTED,n/a")))
(runs:run-tests target
runname
#f ;; (common:args-get-testpatt #f)
;; (or (args:get-arg "-testpatt")
;; "%")
user
args:arg-hash)))))
;;======================================================================
;; run one test
;;======================================================================
;; 1. find the config file
;; 2. change to the test directory
|
>
>
>
>
>
>
|
>
|
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
|
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
;; state: states
status: #f
new-state-status: "NOT_STARTED,n/a")))
(let* ((config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns")))
(if x (string->number x) #f)))
(rerun-cnt (if config-reruns
config-reruns
1)))
(runs:run-tests target
runname
#f ;; (common:args-get-testpatt #f)
;; (or (args:get-arg "-testpatt")
;; "%")
user
args:arg-hash
run-count: rerun-cnt))))))
;;======================================================================
;; run one test
;;======================================================================
;; 1. find the config file
;; 2. change to the test directory
|