︙ | | | ︙ | |
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
(declare (uses server))
(declare (uses client))
(declare (uses tests))
(declare (uses genexample))
;; (declare (uses daemon))
(declare (uses db))
;; (declare (uses dcommon))
(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
|
>
>
>
>
>
>
>
|
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
(declare (uses server))
(declare (uses client))
(declare (uses tests))
(declare (uses genexample))
;; (declare (uses daemon))
(declare (uses db))
;; (declare (uses dcommon))
(declare (uses commonmod))
(import commonmod)
(declare (uses rmtmod))
(import rmtmod)
(declare (uses dbmod))
(import dbmod)
(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
|
︙ | | | ︙ | |
513
514
515
516
517
518
519
520
521
522
523
524
525
526
|
(if (not (directory-exists? log-dir))
(system (conc "mkdir -p " log-dir)))
(open-output-file logpath))
(exn ()
(debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath)
(define *didsomething* #t)
(exit 1))))
;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
(handle-exceptions
|
>
>
>
>
>
>
|
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
|
(if (not (directory-exists? log-dir))
(system (conc "mkdir -p " log-dir)))
(open-output-file logpath))
(exn ()
(debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath)
(define *didsomething* #t)
(exit 1))))
;; (set! *functions* dbmod#*functions*)
;; (set! apimod#*functions* dbmod#*functions*)
;; (set! configfmod#*functions* dbmod#*functions*)
(include "migrate-fix.scm")
;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
;; where (launch:setup) returns #f?
;;
(if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
(handle-exceptions
|
︙ | | | ︙ | |
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
|
(exit 1))))
homehost-required))))
;;======================================================================
;; Misc setup stuff
;;======================================================================
(debug:setup)
(if (args:get-arg "-logging")(set! *logging* #t))
(if (debug:debug-mode 3) ;; we are obviously debugging
(set! open-run-close open-run-close-no-exception-handling))
(if (args:get-arg "-itempatt")
|
|
|
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
|
(exit 1))))
homehost-required))))
;;======================================================================
;; Misc setup stuff
;;======================================================================
(debug:setup (args:get-arg "-debug")(args:get-arg "-v")(args:get-arg "-q"))
(if (args:get-arg "-logging")(set! *logging* #t))
(if (debug:debug-mode 3) ;; we are obviously debugging
(set! open-run-close open-run-close-no-exception-handling))
(if (args:get-arg "-itempatt")
|
︙ | | | ︙ | |
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
|
(else
(begin
(set! *db* dbstruct)
(import extras) ;; might not be needed
;; (import csi)
(import readline)
(import apropos)
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
(if *use-new-readline*
(begin
(install-history-file (get-environment-variable "HOME") ".megatest_history") ;; [homedir] [filename] [nlines])
(current-input-port (make-readline-port "megatest> ")))
(begin
|
>
>
>
|
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
|
(else
(begin
(set! *db* dbstruct)
(import extras) ;; might not be needed
;; (import csi)
(import readline)
(import apropos)
(import dbmod)
(import rmtmod)
(import commonmod)
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
(if *use-new-readline*
(begin
(install-history-file (get-environment-variable "HOME") ".megatest_history") ;; [homedir] [filename] [nlines])
(current-input-port (make-readline-port "megatest> ")))
(begin
|
︙ | | | ︙ | |