18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
;; (include "common.scm")
(include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses client))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses dbfile))
(declare (uses dbfile.import))
;; (declare (uses debugprint))
;; (declare (uses debugprint.import))
;; (declare (uses mtargs))
;; (declare (uses mtargs.import))
;; (declare (uses ftail))
;; (import ftail)
(import dbmod
commonmod
dbfile)
(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")
|
>
>
>
>
>
>
>
>
>
>
>
>
<
<
|
|
|
|
|
<
|
|
|
>
>
>
>
>
>
>
>
>
>
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
;; (include "common.scm")
(include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
;; notes:
;; 1. the uses of .import are needed
;; 2. the order is important
;;
(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses artifacts))
(declare (uses artifacts.import))
(declare (uses dbfile))
(declare (uses dbfile.import))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(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))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbmod.import))
(declare (uses rmtmod))
(declare (uses clientmod))
(declare (uses clientmod.import))
(declare (uses servermod))
(declare (uses servermod.import))
;; (declare (uses mtargs))
;; (declare (uses mtargs.import))
;; (declare (uses ftail))
;; (import ftail)
(import commonmod
debugprint
dbfile
dbmod
servermod
)
(include "commonmod.import.scm")
(include "artifacts.import.scm")
(include "rmtmod.import.scm")
(include "clientmod.import.scm")
(include "servermod.import.scm")
(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")
|
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
|
;; 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.
;;
(if (args:get-arg "-server")
(let ((tl (launch:setup)))
;; (server:launch 0 'http)
(http-transport:launch)
(set! *didsomething* #t)))
;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to
;; a specific Megatest area. Detail are being hashed out and this may change.
;;
(if (args:get-arg "-adjutant")
(begin
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
|
;; 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.
;;
(if (args:get-arg "-server")
(let* ((tl (launch:setup))
(srvdat (server:setup tl))
(handler (lambda (dbstruct cmd params)
(api:execute-requests dbstruct (if (string? cmd)
(string->symbol cmd)
cmd)
(db:string->obj params)))))
(server:set-handler srvdat handler)
(srv-obj-to-str-set! srvdat db:obj->string)
(srv-str-to-obj-set! srvdat db:string->obj)
(srv-dbstruct-set! srvdat (db:setup #t))
(thread-join!
(thread-start! (make-thread
(lambda ()
(server:run srvdat)))))
;; (server:launch 0 'http)
;; (http-transport:launch) ;; NOTE: Need to replace this call
(set! *didsomething* #t)))
;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to
;; a specific Megatest area. Detail are being hashed out and this may change.
;;
(if (args:get-arg "-adjutant")
(begin
|
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
|
(else
(begin
(set! *db* dbstructs)
(import extras) ;; might not be needed
;; (import csi)
(import readline)
(import apropos)
(import dbfile)
;; (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> ")))
|
>
>
>
|
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
|
(else
(begin
(set! *db* dbstructs)
(import extras) ;; might not be needed
;; (import csi)
(import readline)
(import apropos)
(import commonmod)
(import rmtmod)
(import apimod)
(import dbfile)
;; (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> ")))
|