| ︙ | | |
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
|
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
|
+
+
-
+
-
-
-
+
+
-
+
+
|
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses margs))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses runs))
(declare (uses launch))
(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))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbmod.import))
(declare (uses commonmod))
(declare (uses dbfile))
(declare (uses commonmod.import))
(declare (uses dbfile))
(declare (uses dbfile.import))
dbfile)
dbfile
tcp-transport)
(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")
|
| ︙ | | |
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
+
+
|
;;
(use sparse-vectors)
(require-library mutils)
(define *usage-log-file* #f) ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file
(include "transport-mode.scm")
(dbfile:db-init-proc db:initialize-main-db)
;; 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)
|
| ︙ | | |
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
|
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
|
-
-
+
+
-
|
;; 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
exn
(begin
(print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
)
|
| ︙ | | |
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
|
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
|
+
-
+
-
-
+
+
+
+
+
+
+
+
+
+
|
;; 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* ((run-id (args:get-arg-number "-run-id"))
(let ((tl (launch:setup)))
;; (server:launch 0 'http)
(http-transport:launch)
|
| ︙ | | |