︙ | | | ︙ | |
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
launchmod
processmod
rmtmod
runsmod
servermod
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")
|
|
>
|
>
>
>
>
>
>
>
>
|
|
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
launchmod
processmod
rmtmod
runsmod
servermod
tasksmod
testsmod
ulex
)
;; ;; ulex parameters
;; (work-method 'direct)
;; (return-method 'direct)
;; ulex parameters
(work-method 'mailbox)
(return-method 'mailbox)
;; 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
|
|
|
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
|
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!
|
<
<
<
<
<
<
<
<
|
510
511
512
513
514
515
516
517
518
519
520
521
522
523
|
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"))
|
<
<
|
827
828
829
830
831
832
833
834
835
836
837
838
839
840
|
(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"))
|
︙ | | | ︙ | |
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
|
sheetname sectionname varname val)))
(sqlite3:finalize! db)))
(else
(pp data))))))
(if out-file (close-output-port out-port))
(exit) ;; yes, bending the rules here - need to exit since this is a utility
))
(if (args:get-arg "-ping")
(let* ((server-id (string->number (args:get-arg "-ping"))) ;; extract run-id (i.e. no ":"
(host:port (args:get-arg "-ping")))
(server:ping (or server-id host:port) #f do-exit: #t)))
;;======================================================================
;; Capture, save and manipulate environments
;;======================================================================
;; NOTE: Keep these above the section where the server or client code is setup
|
|
>
>
|
|
|
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
|
sheetname sectionname varname val)))
(sqlite3:finalize! db)))
(else
(pp data))))))
(if out-file (close-output-port out-port))
(exit) ;; yes, bending the rules here - need to exit since this is a utility
))
;; disabled for now
#;(if (args:get-arg "-ping")
(let* ((server-id (string->number (args:get-arg "-ping"))) ;; extract run-id (i.e. no ":"
(host:port (args:get-arg "-ping")))
(server-ready? (or server-id host:port) #f do-exit: #t)))
;;======================================================================
;; Capture, save and manipulate environments
;;======================================================================
;; NOTE: Keep these above the section where the server or client code is setup
|
︙ | | | ︙ | |
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
|
(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)
|
|
|
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
|
(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)
|
︙ | | | ︙ | |
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
|
((1)(exit 1))
((2)(exit 2))
(else (exit 3)))))
)
)
(import megatest-main)
(import commonmod)
(main)
|
|
|
|
>
>
>
>
|
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
|
((1)(exit 1))
((2)(exit 2))
(else (exit 3)))))
)
)
(import megatest-main commonmod)
(import srfi-18)
(thread-join!
(thread-start!
(make-thread main)))
|