︙ | | | ︙ | |
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
tasksmod
testsmod
)
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(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")
;; (include "test_records.scm")
|
|
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
tasksmod
testsmod
)
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(define *didsomething* #f)
(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")
;; (include "test_records.scm")
|
︙ | | | ︙ | |
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
|
newlogf)
logpath-in)))
(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-in)
(define *didsomething* #t)
(exit 1))))
;; Disabled help items
;; -rollup : (currently disabled) fill run (set by :runname) with latest test(s)
;; from prior runs with same keys
;; -daemonize : fork into background and disconnect from stdin/out
|
|
|
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
|
newlogf)
logpath-in)))
(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-in)
(set! *didsomething* #t)
(exit 1))))
;; Disabled help items
;; -rollup : (currently disabled) fill run (set by :runname) with latest test(s)
;; from prior runs with same keys
;; -daemonize : fork into background and disconnect from stdin/out
|
︙ | | | ︙ | |
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
|
Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))
(define (main)
(make-and-init-bigdata)
;; set up the functions in http transport
;; (hash-table-set! *http-functions* 'api:process-request api:process-request)
;; (hash-table-set! *http-functions* 'http-transport:main-page http-transport:main-page)
;; (hash-table-set! *http-functions* 'http-transport:show-jquery http-transport:show-jquery)
;; (hash-table-set! *http-functions* 'http-transport:html-test-log http-transport:html-test-log)
;; (hash-table-set! *http-functions* 'http-transport:html-dboard http-transport:html-dboard)
;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
(if (common:file-exists? debugcontrolf)
(load debugcontrolf)))
;; usage logging, careful with this, it is not designed to deal with all real world challenges!
|
<
<
<
<
<
<
<
<
|
501
502
503
504
505
506
507
508
509
510
511
512
513
514
|
Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))
(define (main)
(make-and-init-bigdata)
;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
(if (common:file-exists? debugcontrolf)
(load debugcontrolf)))
;; usage logging, careful with this, it is not designed to deal with all real world challenges!
|
︙ | | | ︙ | |
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
|
(exit)))
(if (args:get-arg "-version")
(begin
(print (common:version-signature)) ;; (print megatest-version)
(exit)))
(define *didsomething* #f)
;; Overall exit handling setup immediately
;;
(if (or (args:get-arg "-process-reap"))
;; (args:get-arg "-runtests")
;; (args:get-arg "-execute")
;; (args:get-arg "-remove-runs")
;; (args:get-arg "-runstep"))
|
<
<
|
818
819
820
821
822
823
824
825
826
827
828
829
830
831
|
(exit)))
(if (args:get-arg "-version")
(begin
(print (common:version-signature)) ;; (print megatest-version)
(exit)))
;; Overall exit handling setup immediately
;;
(if (or (args:get-arg "-process-reap"))
;; (args:get-arg "-runtests")
;; (args:get-arg "-execute")
;; (args:get-arg "-remove-runs")
;; (args:get-arg "-runstep"))
|
︙ | | | ︙ | |
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
|
(bdat-time-to-exit-set! *bdat* #t)
)
;;(debug:print-info 13 *default-log-port* "thread-join! watchdog")
;; join the watchdog thread if it has been thread-start!ed (it may not have been started in the case of a server that never enters running state)
;; (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead)
;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
(let* ((watchdog (bdat-watchdog *bdat*)))
(if (thread? watchdog)
(case (thread-state watchdog)
((ready running blocked sleeping terminated dead)
(thread-join! watchdog)))))
(bdat-time-to-exit-set! *bdat* #t)
|
|
|
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
|
(bdat-time-to-exit-set! *bdat* #t)
)
;;(debug:print-info 13 *default-log-port* "thread-join! watchdog")
;; join the watchdog thread if it has been thread-start!ed (it may not have been started in the case of a server that never enters running state)
;; (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead)
;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
#;(let* ((watchdog (bdat-watchdog *bdat*)))
(if (thread? watchdog)
(case (thread-state watchdog)
((ready running blocked sleeping terminated dead)
(thread-join! watchdog)))))
(bdat-time-to-exit-set! *bdat* #t)
|
︙ | | | ︙ | |