| ︙ | | |
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
+
-
+
+
|
(declare (uses genexample))
(declare (uses rmtmod))
(declare (uses archivemod))
(declare (uses mutils))
(declare (uses odsmod))
(declare (uses testsmod))
(declare (uses diff-report))
(declare (uses tdb))
(use srfi-69 readline)
(use srfi-69)
(import csi)
(module mtbody
*
(import scheme)
(cond-expand
(chicken-4
|
| ︙ | | |
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
-
+
|
files
matchable
md5
message-digest
pathname-expand
posix
posix-extras
readline
;; readline
regex
regex-case
sparse-vectors
srfi-1
srfi-18
srfi-69
typed-records
|
| ︙ | | |
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
-
+
+
|
typed-records
system-information
debugprint
)))
;; imports common to chk5 and ck4
(import srfi-13)
(import srfi-13
csi)
(import (prefix mtargs args:)
archivemod
debugprint
dbmod
commonmod
processmod
|
| ︙ | | |
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
148
149
150
151
152
153
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
|
+
+
+
-
-
-
+
+
+
+
+
|
envmod
apimod
genexample
mutils
odsmod
testsmod
diff-report
tdb
)
(include "common_records.scm")
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
;; (set! toplevel-command toplevel-command)
;; (include "common_records.scm")
;; (include "key_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:))
(use readline apropos json http-client directory-utils typed-records)
(use http-client srfi-18 extras format tcp-server tcp)
(import (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:))
(import
;; readline
apropos json http-client directory-utils typed-records)
(import http-client srfi-18 extras format tcp-server tcp)
;; Added for csv stuff - will be removed
;;
(use sparse-vectors)
(require-library mutils)
|
| ︙ | | |
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
|
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
|
-
+
|
(lambda (target runname keys keyvals)
(runs:handle-locking
target
keys
(or (args:get-arg "-runname")(args:get-arg ":runname") )
(args:get-arg "-lock")
(args:get-arg "-unlock")
user))))
(current-user-name)))))
;;======================================================================
;; Get paths to tests
;;======================================================================
;; Get test paths matching target, runname, and testpatt
(if (or (args:get-arg "-test-files")(args:get-arg "-test-paths"))
;; if we are in a test use the MT_CMDINFO data
|
| ︙ | | |
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
|
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
|
-
+
|
;; (debug:print 0 *default-log-port* "Servers are not running on this host or no servers alive. Cannot run cleanup-db")
;; (exit 1)))
(let ((dbstructs (db:setup)))
(common:cleanup-db dbstructs))
(set! *didsomething* #t)))
(if (args:get-arg "-mark-incompletes")
#;(if (args:get-arg "-mark-incompletes")
(begin
(if (not (launch:setup))
(begin
(debug:print 0 *default-log-port* "Failed to setup, exiting")
(exit 1)))
(open-run-close db:find-and-mark-incomplete #f)
(set! *didsomething* #t)))
|
| ︙ | | |
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
|
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
|
-
|
;;======================================================================
;; Start a repl
;;======================================================================
;; fakeout readline
(include "readline-fix.scm")
|
| ︙ | | |
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
|
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
|
-
+
+
-
+
+
-
-
+
+
|
;; #!/bin/bash
;;
;; export MT_RUNSCRIPT=yes
;; megatest << EOF
;; (print "Hello world")
;; (exit)
;; EOF
(repl))
(else
(begin
(define toplevel-command (lambda (a b)(print a " "b)))
(set! *db* dbstructs)
(import extras) ;; might not be needed
;; (import csi)
(import readline)
;; (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> ")))
#;(install-history-file (get-environment-variable "HOME") ".megatest_history") ;; [homedir] [filename] [nlines])
#;(current-input-port (make-readline-port "megatest> ")))
#;(begin
(gnu-history-install-file-manager
(string-append
(or (get-environment-variable "HOME") ".") "/.megatest_history"))
(current-input-port (make-gnu-readline-port "megatest> "))))
(if (args:get-arg "-repl")
(repl)
|
| ︙ | | |