Megatest

Check-in [7060a6d776]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Lots of proper use of debugprint and mtargs plus some small cleanup.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 7060a6d776fbe09754286fbebfd65d586befb1a2
User & Date: mrwellan on 2023-03-27 18:15:58
Other Links: branch diff | manifest | tags
Context
2023-03-27
19:33
Changed version to 1.8012. check-in: bcc22ebf3c user: mmgraham tags: v1.80, v1.8012
18:15
Lots of proper use of debugprint and mtargs plus some small cleanup. check-in: 7060a6d776 user: mrwellan tags: v1.80
15:51
merged fork check-in: f7059c9604 user: mrwellan tags: v1.80
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified api.scm from [33941a7679] to [ff600f6f10].

︙
17
18
19
20
21
22
23

24
25
26
27
28
29
30

31
32
33
34
35
36
37

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39








+







+








;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (unit api))
(declare (uses rmt))
(declare (uses db))
(declare (uses debugprint))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses tasks))
(declare (uses tcp-transportmod))

(import dbmod)
(import dbfile)
(import debugprint)
(import tcp-transportmod)

(use srfi-69
     posix
     matchable
     s11n)
︙

Modified archive.scm from [4a17a50d56] to [d5e209de94].

︙
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30

31
32
33
34
35
36
37

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39








+








+








;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(declare (unit archive))
(declare (uses db))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses common))
(declare (uses commonmod))

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69
     format md5 message-digest srfi-18)

(import commonmod
	debugprint
	(prefix mtargs args:))

(include "common_records.scm")
(include "db_records.scm")

;;======================================================================
;;
︙

Modified client.scm from [cc83111095] to [091f168690].

︙
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32





33


34
35
36
37
38
39
40

16
17
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








-
-
-
-






+
+
+
+
+
-
+
+








;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================
;; C L I E N T S
;;======================================================================

(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
     message-digest matchable spiffy uri-common intarweb http-client
     spiffy-request-vars uri-common intarweb directory-utils)

(declare (unit client))

(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses commonmod))

(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
     message-digest matchable spiffy uri-common intarweb http-client
     spiffy-request-vars uri-common intarweb directory-utils)

(import commonmod)
(import commonmod
	debugprint)

(module client
*

)

(import client)
︙

Modified common.scm from [7127d3c740] to [c775026c92].

︙
13
14
15
16
17
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

13
14
15
16
17
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








+
+
+
+
+












-
-
-
-

+








;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit common))
(declare (uses commonmod))
(declare (uses debugprint))
(declare (uses mtargs))

(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 udp ;; sql-de-lite
     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     pkts (prefix dbi dbi:)
     )
(use posix-extras pathname-expand files)


(declare (unit common))
(declare (uses commonmod))
(declare (uses mtargs))

(import commonmod
	debugprint
	(prefix mtargs args:))

(include "common_records.scm")


;; (require-library margs)
;; (include "margs.scm")
︙

Modified common_records.scm from [80f9e14f2d] to [0bd4438bf6].

︙
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
















102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208

























































209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247




























248
249
250
251
252
253
254

79
80
81
82
83
84
85
















86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102















































103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219




























220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    (mutex-unlock! mtx)
    res))

;; this was cached based on results from profiling but it turned out the profiling
;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
;; in for now but can probably take it out later.
;;
(define (debug:calc-verbosity vstr)
  (or (hash-table-ref/default *verbosity-cache* vstr #f)
      (let ((res (cond
                  ((number? vstr) vstr)
                  ((not (string?  vstr))   1)
                  ;; ((string-match  "^\\s*$" vstr) 1)
                  (vstr           (let ((debugvals  (filter number? (map string->number (string-split vstr ",")))))
                                    (cond
                                     ((> (length debugvals) 1) debugvals)
                                     ((> (length debugvals) 0)(car debugvals))
                                     (else 1))))
                  ((args:get-arg "-v")   2)
                  ((args:get-arg "-q")    0)
                  (else                   1))))
        (hash-table-set! *verbosity-cache* vstr res)
        res)))
;; (define (debug:calc-verbosity vstr)
;;   (or (hash-table-ref/default *verbosity-cache* vstr #f)
;;       (let ((res (cond
;;                   ((number? vstr) vstr)
;;                   ((not (string?  vstr))   1)
;;                   ;; ((string-match  "^\\s*$" vstr) 1)
;;                   (vstr           (let ((debugvals  (filter number? (map string->number (string-split vstr ",")))))
;;                                     (cond
;;                                      ((> (length debugvals) 1) debugvals)
;;                                      ((> (length debugvals) 0)(car debugvals))
;;                                      (else 1))))
;;                   ((args:get-arg "-v")   2)
;;                   ((args:get-arg "-q")    0)
;;                   (else                   1))))
;;         (hash-table-set! *verbosity-cache* vstr res)
;;         res)))

;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
  (if (not (or (number? verbosity)
	       (list?   verbosity)))
      (begin
	(print "ERROR: Invalid debug value \"" vstr "\"")
	#f)
      #t))

(define (debug:debug-mode n)
  (cond
   ((and (number? *verbosity*)   ;; number number
	 (number? n))
    (<= n *verbosity*))
   ((and (list? *verbosity*)     ;; list   number
	 (number? n))
    (member n *verbosity*))
   ((and (list? *verbosity*)     ;; list   list
	 (list? n))
    (not (null? (lset-intersection! eq? *verbosity* n))))
   ((and (number? *verbosity*)
	 (list? n))
    (member *verbosity* n))))

(define (debug:setup)
  (let ((debugstr (or (args:get-arg "-debug")
		      (args:get-arg "-debug-noprop")
		      (getenv "MT_DEBUG_MODE"))))
    (set! *verbosity* (debug:calc-verbosity debugstr))
    (debug:check-verbosity *verbosity* debugstr)
    ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
    (if (not *verbosity*)(set! *verbosity* 1))
    (if (and (not (args:get-arg "-debug-noprop"))
	     (or (args:get-arg "-debug")
		 (not (getenv "MT_DEBUG_MODE"))))
	(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
				    (string-intersperse (map conc *verbosity*) ",")
				    (conc *verbosity*))))))
  
(define (debug:print n e . params)
  (if (debug:debug-mode n)
      (with-output-to-port (or e (current-error-port))
	(lambda ()
	  (if *logging*
	      (db:log-event (apply conc params))
	      (apply print params)
	      )))))
;; ;; check verbosity, #t is ok
;; (define (debug:check-verbosity verbosity vstr)
;;   (if (not (or (number? verbosity)
;; 	       (list?   verbosity)))
;;       (begin
;; 	(print "ERROR: Invalid debug value \"" vstr "\"")
;; 	#f)
;;       #t))
;; 
;; (define (debug:debug-mode n)
;;   (cond
;;    ((and (number? *verbosity*)   ;; number number
;; 	 (number? n))
;;     (<= n *verbosity*))
;;    ((and (list? *verbosity*)     ;; list   number
;; 	 (number? n))
;;     (member n *verbosity*))
;;    ((and (list? *verbosity*)     ;; list   list
;; 	 (list? n))
;;     (not (null? (lset-intersection! eq? *verbosity* n))))
;;    ((and (number? *verbosity*)
;; 	 (list? n))
;;     (member *verbosity* n))))
;; 
;; (define (debug:setup)
;;   (let ((debugstr (or (args:get-arg "-debug")
;; 		      (args:get-arg "-debug-noprop")
;; 		      (getenv "MT_DEBUG_MODE"))))
;;     (set! *verbosity* (debug:calc-verbosity debugstr))
;;     (debug:check-verbosity *verbosity* debugstr)
;;     ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
;;     (if (not *verbosity*)(set! *verbosity* 1))
;;     (if (and (not (args:get-arg "-debug-noprop"))
;; 	     (or (args:get-arg "-debug")
;; 		 (not (getenv "MT_DEBUG_MODE"))))
;; 	(setenv "MT_DEBUG_MODE" (if (list? *verbosity*)
;; 				    (string-intersperse (map conc *verbosity*) ",")
;; 				    (conc *verbosity*))))))
;;   
;; (define (debug:print n e . params)
;;   (if (debug:debug-mode n)
;;       (with-output-to-port (or e (current-error-port))
;; 	(lambda ()
;; 	  (if *logging*
;; 	      (db:log-event (apply conc params))
;; 	      (apply print params)
;; 	      )))))

;; Brandon's debug printer shortcut (indulge me :)
(define *BB-process-starttime* (current-milliseconds))
(define (BB> . in-args)
  (let* ((stack (get-call-chain))
         (location "??"))
    (for-each
     (lambda (frame)
       (let* ((this-loc (vector-ref frame 0))
              (temp     (string-split (->string this-loc) " "))
              (this-func (if (and (list? temp) (> (length temp) 1)) (cadr temp) "???")))
         (if (equal? this-func "BB>")
             (set! location this-loc))))
     stack)
    (let* ((color-on "\x1b[1m")
           (color-off "\x1b[0m")
           (dp-args
            (append
             (list 0 *default-log-port*
                   (conc color-on location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000) color-off "   ")  )
             in-args)))
      (apply debug:print dp-args))))

(define *BBpp_custom_expanders_list* (make-hash-table))



;; register hash tables with BBpp.
(hash-table-set! *BBpp_custom_expanders_list* HASH_TABLE:
                 (cons hash-table? hash-table->alist))

;; test name converter
(define (BBpp_custom_converter arg)
  (let ((res #f))
    (for-each
     (lambda (custom-type-name)
       (let* ((custom-type-info      (hash-table-ref *BBpp_custom_expanders_list* custom-type-name))
              (custom-type-test      (car custom-type-info))
              (custom-type-converter (cdr custom-type-info)))
         (when (and (not res) (custom-type-test arg))
           (set! res (custom-type-converter arg)))))
     (hash-table-keys *BBpp_custom_expanders_list*))
    (if res (BBpp_ res) arg)))

(define (BBpp_ arg)
  (cond
   ;;((SOMESTRUCT? arg) (cons SOMESTRUCT: (SOMESTRUCT->alist arg)))
   ;;((dboard:tabdat? arg) (cons dboard:tabdat: (dboard:tabdat->alist arg)))
   ((hash-table? arg)
    (let ((al (hash-table->alist arg)))
      (BBpp_ (cons HASH_TABLE: al))))
   ((null? arg) '())
   ;;((list? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
   ((pair? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
   (else (BBpp_custom_converter arg))))

;; Brandon's pretty printer.  It expands hashes and custom types in addition to regular pp
(define (BBpp arg)
  (pp (BBpp_ arg)))
;; (define *BB-process-starttime* (current-milliseconds))
;; (define (BB> . in-args)
;;   (let* ((stack (get-call-chain))
;;          (location "??"))
;;     (for-each
;;      (lambda (frame)
;;        (let* ((this-loc (vector-ref frame 0))
;;               (temp     (string-split (->string this-loc) " "))
;;               (this-func (if (and (list? temp) (> (length temp) 1)) (cadr temp) "???")))
;;          (if (equal? this-func "BB>")
;;              (set! location this-loc))))
;;      stack)
;;     (let* ((color-on "\x1b[1m")
;;            (color-off "\x1b[0m")
;;            (dp-args
;;             (append
;;              (list 0 *default-log-port*
;;                    (conc color-on location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000) color-off "   ")  )
;;              in-args)))
;;       (apply debug:print dp-args))))
;; 
;; (define *BBpp_custom_expanders_list* (make-hash-table))
;; 
;; 
;; 
;; ;; register hash tables with BBpp.
;; (hash-table-set! *BBpp_custom_expanders_list* HASH_TABLE:
;;                  (cons hash-table? hash-table->alist))
;; 
;; ;; test name converter
;; (define (BBpp_custom_converter arg)
;;   (let ((res #f))
;;     (for-each
;;      (lambda (custom-type-name)
;;        (let* ((custom-type-info      (hash-table-ref *BBpp_custom_expanders_list* custom-type-name))
;;               (custom-type-test      (car custom-type-info))
;;               (custom-type-converter (cdr custom-type-info)))
;;          (when (and (not res) (custom-type-test arg))
;;            (set! res (custom-type-converter arg)))))
;;      (hash-table-keys *BBpp_custom_expanders_list*))
;;     (if res (BBpp_ res) arg)))
;; 
;; (define (BBpp_ arg)
;;   (cond
;;    ;;((SOMESTRUCT? arg) (cons SOMESTRUCT: (SOMESTRUCT->alist arg)))
;;    ;;((dboard:tabdat? arg) (cons dboard:tabdat: (dboard:tabdat->alist arg)))
;;    ((hash-table? arg)
;;     (let ((al (hash-table->alist arg)))
;;       (BBpp_ (cons HASH_TABLE: al))))
;;    ((null? arg) '())
;;    ;;((list? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
;;    ((pair? arg) (cons (BBpp_ (car arg)) (BBpp_ (cdr arg))))
;;    (else (BBpp_custom_converter arg))))
;; 
;; ;; Brandon's pretty printer.  It expands hashes and custom types in addition to regular pp
;; (define (BBpp arg)
;;   (pp (BBpp_ arg)))

;(use define-macro)
(define-syntax inspect
  (syntax-rules ()
    [(_ x)
    ;; (with-output-to-port (current-error-port)
       (printf "~a is: ~a\n" 'x (with-output-to-string (lambda () (BBpp x))))
     ;;  )
     ]
    [(_ x y ...) (begin (inspect x) (inspect y ...))]))

(define (debug:print-error n e . params)
  ;; normal print
  (if (debug:debug-mode n)
      (with-output-to-port (if (port? e) e (current-error-port))
	(lambda ()
	  (if *logging*
	      (db:log-event (apply conc params))
	      ;; (apply print "pid:" (current-process-id) " " params)
	      (apply print "ERROR: " params)
	      ))))
  ;; pass important messages to stderr
  (if (and (eq? n 0)(not (eq? e (current-error-port)))) 
      (with-output-to-port (current-error-port)
	(lambda ()
	  (apply print "ERROR: " params)
	  ))))

(define (debug:print-info n e . params)
  (if (debug:debug-mode n)
      (with-output-to-port (if (port? e) e (current-error-port))
	(lambda ()
	  (if *logging*
	      (let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params))))
		(db:log-event res))
	      ;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res)
	      (apply print "INFO: (" n ") " params) ;; res)
	      )))))

;; (define (debug:print-error n e . params)
;;   ;; normal print
;;   (if (debug:debug-mode n)
;;       (with-output-to-port (if (port? e) e (current-error-port))
;; 	(lambda ()
;; 	  (if *logging*
;; 	      (db:log-event (apply conc params))
;; 	      ;; (apply print "pid:" (current-process-id) " " params)
;; 	      (apply print "ERROR: " params)
;; 	      ))))
;;   ;; pass important messages to stderr
;;   (if (and (eq? n 0)(not (eq? e (current-error-port)))) 
;;       (with-output-to-port (current-error-port)
;; 	(lambda ()
;; 	  (apply print "ERROR: " params)
;; 	  ))))
;; 
;; (define (debug:print-info n e . params)
;;   (if (debug:debug-mode n)
;;       (with-output-to-port (if (port? e) e (current-error-port))
;; 	(lambda ()
;; 	  (if *logging*
;; 	      (let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params))))
;; 		(db:log-event res))
;; 	      ;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res)
;; 	      (apply print "INFO: (" n ") " params) ;; res)
;; 	      )))))
;; 


;; if a value is printable (i.e. string or number) return the value
;; else return an empty string
(define-inline (printable val)
  (if (or (number? val)(string? val)) val ""))

Modified configf.scm from [2f0774f40c] to [c2f41c907e].

︙
23
24
25
26
27
28
29

30


31
32
33
34


35
36
37
38
39
40
41

23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45








+

+
+



-
+
+








;;======================================================================

(use regex regex-case matchable) ;;  directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses keys))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses mtargs.import))
(declare (uses common))
(declare (uses commonmod))
(declare (uses commonmod.import))
(import commonmod
	(prefix mtargs args:))
	(prefix mtargs args:)
	debugprint)

(include "common_records.scm")

;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
  (if toppath
      (let ((cfname (conc toppath "/" configname)))
︙

Modified dashboard-context-menu.scm from [9827592e3b] to [7b1d8c53c1].

︙
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

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








-
-
-
-
-
-
-
-
-











+
+
+
+
+
+
+
+
+




-
+
+








;;======================================================================

;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================

(use format fmt)
(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)

(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))

(declare (unit dashboard-context-menu))
(declare (uses common))
(declare (uses commonmod))
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))

(use format fmt)
(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)

(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

(import commonmod)
(import commonmod
	debugprint)

(define (dboard:launch-testpanel run-id test-id)
  (let* ((dboardexe (common:find-local-megatest "dashboard"))
         (cmd (conc dboardexe
                    " -test " run-id "," test-id
                    " &")))
    (system cmd)))
︙

Modified dashboard-tests.scm from [124658aa85] to [5b3bc1a5e0].

︙
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

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








-
-
-
-
-
-
-
-
-










+

+
+
+
+
+
+
+
+
+
-
+
+









;;======================================================================

;;======================================================================
;; Test info panel
;;======================================================================

(use format fmt)
(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)

(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))

(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses commonmod))
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
(declare (uses debugprint))

(use format fmt)
(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)

(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))

(import commonmod)
(import commonmod
	debugprint)

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

;;======================================================================
;; C O M M O N
︙

Modified dashboard.scm from [7b9e490b60] to [6c0b02e4d4].

︙
16
17
18
19
20
21
22

23
24

25
26
27
28
29
30
31

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33








+


+








;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (uses common))
(declare (uses mtargs))
(declare (uses mtargs.import))
(declare (uses keys))
(declare (uses items))
(declare (uses debugprint))
(declare (uses db))
(declare (uses configf))
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses tree))
︙
51
52
53
54
55
56
57
58


59
60
61
62
63
64
65

53
54
55
56
57
58
59

60
61
62
63
64
65
66
67
68








-
+
+









(use ducttape-lib)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct

(import commonmod
	(prefix mtargs args:)
	dbmod
	dbfile)
	dbfile
	debugprint)

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
︙
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374








375
376
377
378
379
380
381

363
364
365
366
367
368
369








370
371
372
373
374
375
376
377
378
379
380
381
382
383
384








-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+








  ;; runs summary view
  
  tests-tree       ;; used in newdashboard
  )

;; register tabdat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:tabdat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* TABDAT:
                 (cons dboard:tabdat?
                       (lambda (tabdat-item)
                         (filter
                          (lambda (alist-entry)
                            (member (car alist-entry)
                                    '(allruns-by-id allruns))) ;; FIELDS OF INTEREST
                          (dboard:tabdat->alist tabdat-item)))))
;; (hash-table-set! *BBpp_custom_expanders_list* TABDAT:
;;                  (cons dboard:tabdat?
;;                        (lambda (tabdat-item)
;;                          (filter
;;                           (lambda (alist-entry)
;;                             (member (car alist-entry)
;;                                     '(allruns-by-id allruns))) ;; FIELDS OF INTEREST
;;                           (dboard:tabdat->alist tabdat-item)))))



(define (dboard:tabdat-target-string vec)
  (let ((targ (dboard:tabdat-target vec)))
    (if (list? targ)(string-intersperse targ "/") "no-target-specified")))
︙
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526








527
528
529
530
531
532
533

515
516
517
518
519
520
521








522
523
524
525
526
527
528
529
530
531
532
533
534
535
536








-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+








  status
  start-time
  duration
  )

;; register dboard:rundat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
                 (cons dboard:rundat?
                       (lambda (tabdat-item)
                         (filter
                          (lambda (alist-entry)
                            (member (car alist-entry)
                                    '(run run-data-offset ))) ;; FIELDS OF INTEREST
                          (dboard:rundat->alist tabdat-item)))))
;; (hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
;;                  (cons dboard:rundat?
;;                        (lambda (tabdat-item)
;;                          (filter
;;                           (lambda (alist-entry)
;;                             (member (car alist-entry)
;;                                     '(run run-data-offset ))) ;; FIELDS OF INTEREST
;;                           (dboard:rundat->alist tabdat-item)))))




(define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f));; -100 is before time began
  (make-dboard:rundat 
   run: run
︙

Modified db.scm from [65ef661a4e] to [64bc5f4f0d].

︙
31
32
33
34
35
36
37

38
39
40
41
42
43
44

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45








+








(declare (uses dbfile))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))
(declare (uses commonmod))
(declare (uses mtargs))

(import commonmod
	(prefix mtargs args:))

(use (srfi 18)
     extras
     tcp
     stack
︙

Modified dcommon.scm from [4b1e45fd47] to [5c8cf6c819].

︙
14
15
16
17
18
19
20






21
22
23
24
25
26
27
28
29
30
31
32
33
34


35
36
37
38
39
40
41

14
15
16
17
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








+
+
+
+
+
+







-
-
-
-
-
-
-
+
+








;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (unit dcommon))

(declare (uses gutils))
(declare (uses db))
(declare (uses commonmod))

(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use regex typed-records matchable)

(declare (unit dcommon))

(declare (uses gutils))
(declare (uses db))
(declare (uses commonmod))

(import commonmod)
(import commonmod
	debugprint)
;; (declare (uses synchash))

(include "megatest-version.scm")
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
︙

Modified diff-report.scm from [0fbca9ae2f] to [e0510f4e99].

︙
14
15
16
17
18
19
20

21
22
23


24
25
26
27
28
29
30

14
15
16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
32








+


-
+
+








;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(declare (unit diff-report))
(declare (uses common))
(declare (uses debugprint))
(declare (uses rmt))
(declare (uses commonmod))
(import commonmod)
(import commonmod
	debugprint)
         
(include "common_records.scm")
(use matchable)
(use fmt)
(use ducttape-lib)
(define css "")
︙

Modified env.scm from [f159d1ca30] to [84be7d5a91].

︙
16
17
18
19
20
21
22

23
24
25


26
27
28
29
30
31
32

16
17
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33
34








+


-
+
+








;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit env))

(declare (uses debugprint))
(declare (uses mtargs))

(import (prefix mtargs args:))
(import (prefix mtargs args:)
	debugprint)

(use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)

(define (env:open-db fname)
  (let* ((db-exists (common:file-exists? fname))
	 (db        (open-database fname)))
    (if (not db-exists)
︙

Modified ezsteps.scm from [4275b77cb4] to [f2352857f1].

︙
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

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








+











+








;;

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(declare (unit ezsteps))
(declare (uses db))
(declare (uses common))
(declare (uses debugprint))
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses commonmod))
(declare (uses mtargs))

(use srfi-1 posix regex srfi-69 directory-utils call-with-environment-variables posix-extras
     z3 csv typed-records pathname-expand matchable)

(import commonmod
	debugprint
	(prefix mtargs args:))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
︙

Modified genexample.scm from [c6a2ab2853] to [9396be098b].

︙
15
16
17
18
19
20
21



22


23
24
25
26
27
28
29

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34








+
+
+

+
+








;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit genexample))
(declare (uses mtargs))
(declare (uses debugprint))

(use posix regex matchable)
(import (prefix mtargs args:)
	debugprint)

(include "db_records.scm")

(define genexample:example-logpro
#<<EOF
  ;; You should have at least one expect:required. This ensures that your process ran
  ;; comment out the line below and replace "put pattern here" with a pattern that will
︙

Modified http-transport.scm from [c72815cd64] to [8c4ecd6362].

︙
15
16
17
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

15
16
17
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








+

















-
+
+








;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(declare (unit http-transport))

(declare (uses common))
(declare (uses debugprint))
(declare (uses db))
(declare (uses tests))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses server))
;; (declare (uses daemon))
(declare (uses portlogger))
(declare (uses rmt))
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses mtargs))

(require-extension (srfi 18) extras tcp s11n)

(use  srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)

(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)

(import (prefix mtargs args:))
(import (prefix mtargs args:)
	debugprint)

;; Configurations for server
(tcp-buffer-size 2048)
(max-connections 2048) 

(include "common_records.scm")
(include "db_records.scm")
︙

Modified items.scm from [4ca6320933] to [faab56b546].

︙
19
20
21
22
23
24
25

26
27


28
29
30
31
32
33
34

19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36








+

-
+
+









;; (define itemdat '((ripeness    "green ripe overripe")
;; 		     (temperature "cool medium hot")
;; 		     (season      "summer winter fall spring")))

(declare (unit items))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))
(import commonmod)
(import commonmod
	debugprint)

(include "common_records.scm")

;; Puts out all combinations
(define (process-itemlist hierdepth curritemkey itemlist)
  (let ((res '()))
    (if (not hierdepth)
︙

Modified keys.scm from [d7b8d553eb] to [2247f182f0].

︙
17
18
19
20
21
22
23
24
25
26
27
28

29






30


31
32
33
34
35
36
37

17
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








-
-
-


+

+
+
+
+
+
+
-
+
+








;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
 
;;======================================================================
;; Run keys, these are used to hierarchially organise tests and run areas
;;======================================================================

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))

(declare (unit keys))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses mtargs))

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:)
	(prefix mtargs args:))

(import commonmod)
(import commonmod
	debugprint)

(include "key_records.scm")
(include "common_records.scm")

(define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...
  (string-intersperse keys ","))
︙

Modified launch.scm from [c385108812] to [c6034a07ae].

︙
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

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








+













-
+
+








;; launch a task - this runs on the originating host, tests themselves
;;
;;======================================================================

(declare (unit launch))
(declare (uses subrun))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configf))
(declare (uses db))
(declare (uses ezsteps))
(declare (uses dbfile))
(declare (uses mtargs))

(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3
     call-with-environment-variables csv)
(use typed-records pathname-expand matchable)

(import (prefix base64 base64:)
	(prefix sqlite3 sqlite3:)
	(prefix mtargs args:))
	(prefix mtargs args:)
	debugprint)

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")

(import commonmod
︙

Modified lock-queue.scm from [fbbd0328d6] to [5f0ac4e80e].

︙
16
17
18
19
20
21
22

23
24

25


26
27
28
29
30
31
32

16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
35








+


+
-
+
+








;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(use (prefix sqlite3 sqlite3:) srfi-18)

(declare (unit lock-queue))
(declare (uses common))
(declare (uses debugprint))
(declare (uses tasks))
(declare (uses commonmod))

(import commonmod)
(import commonmod
	debugprint)

;;======================================================================
;; attempt to prevent overlapping updates of rollup files by queueing
;; update requests in an sqlite db
;;======================================================================

;;======================================================================
︙

Modified mt.scm from [f748d1dc75] to [86c22fd19d].

︙
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
32


33
34
35
36
37
38
39

17
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








+









+
+








;;


(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils call-with-environment-variables)
(import (prefix sqlite3 sqlite3:))

(declare (unit mt))
(declare (uses debugprint))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses runs))
(declare (uses rmt))
;; (declare (uses filedb))

(import debugprint)

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
︙

Modified mtexec.scm from [3a9610856f] to [fd5a49b5a6].

︙
24
25
26
27
28
29
30
31

32
33
34
35


36
37
38
39
40
41
42

24
25
26
27
28
29
30

31
32
33
34

35
36
37
38
39
40
41
42
43








-
+



-
+
+









(use srfi-1 posix srfi-69 readline ;;  regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
   srfi-19  srfi-18 extras format pkts regex regex-case
     (prefix dbi dbi:)
     )

;; (declare (uses common))
(declare (uses margs))
(declare (uses mtargs))
(declare (uses configf))
;; (declare (uses rmt))
(declare (uses commonmod))
(import commonmod)
(import commonmod
	(prefix mtargs args:))

;; (use ducttape-lib)
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")

;; (require-library stml)
︙

Modified mtut.scm from [b04fee463b] to [4eca70de9f].

︙
11
12
13
14
15
16
17
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

11
12
13
14
15
16
17


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








-
-
+
+
+
+
+
+
+
+
+
+
+











-
-
-
-
-
-
-
+
+








;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

;; (include "common.scm")
;
(declare (uses common))
(declare (uses mtargs))
(declare (uses debugprint))
(declare (uses configf))
;; (declare (uses rmt))
(declare (uses commonmod))
(declare (uses commonmod.import))

(import debugprint)
					; (include "common.scm")
(include "megatest-version.scm")

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(use srfi-1 posix srfi-69 readline ;;  regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
   srfi-19  srfi-18 extras format pkts regex regex-case
     (prefix dbi dbi:)
     (prefix sqlite3 sqlite3:)
     nanomsg)

(declare (uses common))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
(declare (uses commonmod))
(declare (uses commonmod.import))
(import commonmod)
(import commonmod
	(prefix mtargs args:))

(use ducttape-lib)

(include "megatest-fossil-hash.scm")

(require-library stml)
︙

Modified newdashboard.scm from [c27106b5bc] to [eb75f56e00].

︙
14
15
16
17
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

14
15
16
17
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








+
+
+
+
+
+










-
-
-
-
-
+
+
+








;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (uses common))
(declare (uses debugprint))
(declare (uses megatest-version))
(declare (uses mtargs))
(declare (uses commonmod))

(use format)

(use (prefix iup iup:))

(use canvas-draw)
(import canvas-draw-iup)

(use sql-de-lite srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors ;; defstruct
     (prefix dbi dbi:))

(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses commonmod))
(import commonmod)
(import commonmod
	debugprint
	(prefix mtargs args:))

;; (declare (uses launch))
;; (declare (uses gutils))
;; (declare (uses db))
;; (declare (uses server))
;; (declare (uses synchash))
(declare (uses dcommon))
︙

Modified portlogger.scm from [8344cdf37f] to [c0a80358a3].

︙
19
20
21
22
23
24
25

26
27

28
29
30
31
32
33
34

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36








+


+









(require-extension (srfi 18) extras tcp s11n)

(use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3)
(import (prefix sqlite3 sqlite3:))

(declare (unit portlogger))
(declare (uses debugprint))
(declare (uses db))

(import debugprint)
;; lsof -i

(define (portlogger:open-db fname)
  (let* ((avail    (tasks:wait-on-journal fname 5 remove: #t)) ;; wait up to about 10 seconds for the journal to go away
	 (exists   (common:file-exists? fname))
	 (db       (if avail 
		       (sqlite3:open-database fname)
︙

Modified process.scm from [f525bcbf17] to [4050043a66].

︙
20
21
22
23
24
25
26



27
28
29
30
31
32
33

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36








+
+
+









;;======================================================================
;; Process convience utils
;;======================================================================

(use regex directory-utils)
(declare (unit process))
(declare (uses debugprint))

(import debugprint)

(define (process:conservative-read port)
  (let loop ((res ""))
    (if (not (eof-object? (peek-char port)))
	(loop (conc res (read-char port)))
	res)))
︙

Modified rmt.scm from [2b80b3cafb] to [7b6e5d850e].

︙
17
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

17
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








+














+








;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(use format typed-records) ;; RADT => purpose of json format??

(declare (unit rmt))
(declare (uses debugprint))
(declare (uses api))
(declare (uses http-transport))
(declare (uses commonmod))
(declare (uses dbfile))
;; (declare (uses dbmemmod))
(declare (uses dbmod))
(declare (uses tcp-transportmod))
(include "common_records.scm")
(declare (uses rmtmod))

;; used by http-transport
(import dbfile
	rmtmod
	commonmod
	debugprint
;; 	dbmemmod
	dbfile
	dbmod
	tcp-transportmod)

;; http - use the old http + in /tmp db
;; tcp  - use tcp transport with inmem db
︙

Modified runconfig.scm from [7a53eaa476] to [e745c7478e].

︙
20
21
22
23
24
25
26

27

28


29
30
31
32
33
34
35

20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38








+

+
-
+
+








;; to this run field1val/field2val/field3val ...
;;======================================================================

(use format directory-utils)

(declare (unit runconfig))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))

(import commonmod)
(import commonmod
	debugprint)

(include "common_records.scm")

(define (runconfig:read fname target environ-patt)
  (let ((ht (make-hash-table)))
    (if target (hash-table-set! ht target '()))
    (read-config fname ht #t environ-patt: environ-patt sections: (if target (list "default" target) #f))))
︙

Modified runs.scm from [aaf94af15e] to [fbcfc7c544].

︙
13
14
15
16
17
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

13
14
15
16
17
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








-
-
-
-



+







-
+
+
+
+
+
+
+









-
+
+
+








;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format  sxml-serializer
     sxml-modifications matchable)

(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses mt))
(declare (uses archive))
;; (declare (uses filedb))
(declare (uses mtargs))

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format  sxml-serializer
     sxml-modifications matchable)



(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")

;; (include "debugger.scm")

(import commonmod)
(import commonmod
	debugprint
	(prefix mtargs args:))

;; use this struct to facilitate refactoring
;;

(defstruct runs:dat
  reglen regfull
  runname max-concurrent-jobs run-id
︙

Modified server.scm from [851da574f1] to [ca005a962e].

︙
12
13
14
15
16
17
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

12
13
14
15
16
17
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








-
-
-
-
-
-
-



-
+








+

+
+
+
+
+
+
+
-
+
+
+








;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(require-extension (srfi 18) extras tcp s11n)

(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest
     directory-utils posix-extras matchable utils)

(use spiffy uri-common intarweb http-client spiffy-request-vars)

(declare (unit server))

(declare (uses commonmod))

(declare (uses debugprint))
(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
;; (declare (uses synchash))
(declare (uses http-transport))
;;(declare (uses rpc-transport))
(declare (uses launch))
;; (declare (uses daemon))
(declare (uses mtargs))

(require-extension (srfi 18) extras tcp s11n)

(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest
     directory-utils posix-extras matchable utils)

(use spiffy uri-common intarweb http-client spiffy-request-vars)

(import commonmod)
(import commonmod
	debugprint
	(prefix mtargs args:))

(include "common_records.scm")
(include "db_records.scm")

(define (server:make-server-url hostport)
  (if (not hostport)
      #f
︙

Modified subrun.scm from [4fc2a9b685] to [aaf114f8dc].

︙
14
15
16
17
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

14
15
16
17
18
19
20



21

22
23
24
25




26

27

28
29
30
31

32
33
34
35
36
37
38
39
40








-
-
-

-
+



-
-
-
-

-
+
-
+
+
+

-
+
+








;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format
     call-with-environment-variables)
(declare (unit subrun))
;;(declare (uses runs))
(declare (uses debugprint))
(declare (uses db))
(declare (uses common))
(declare (uses commonmod))
;;(declare (uses items))
;;(declare (uses runconfig))
;;(declare (uses tests))
;;(declare (uses server))
(declare (uses mt))
;;(declare (uses archive))

;; (declare (uses filedb))
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format
     call-with-environment-variables)

(import commonmod)
(import commonmod
	debugprint)

;(include "common_records.scm")
;;(include "key_records.scm")
(include "db_records.scm") ;; provides db:test-get-id
;;(include "run_records.scm")
;;(include "test_records.scm")
︙

Modified tasks.scm from [122215daee] to [a5276386f9].

︙
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30





31



32
33
34
35
36
37
38

14
15
16
17
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








-
-
-

+






+
+
+
+
+
-
+
+
+








;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
(import (prefix sqlite3 sqlite3:))

(declare (unit tasks))
(declare (uses debugprint))
(declare (uses dbfile))
(declare (uses db))
(declare (uses rmt))
(declare (uses common))
(declare (uses pgdb))
(declare (uses commonmod))
(declare (uses mtargs))

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
(import (prefix sqlite3 sqlite3:))

(import commonmod)
(import commonmod
	debugprint
	(prefix mtargs args:))

(import dbfile)
;; (import pgdb) ;; pgdb is a module

(include "task_records.scm")
(include "db_records.scm")
︙

Modified tcmt.scm from [bb0554607f] to [b22bc233eb].

︙
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

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








+
+
+
+
+
+





-
-
-
-
-
-
+
+








;;
;; Wrapper to enable running Megatest flows under teamcity
;;
;;  1. Run the megatest process and pass it all the needed parameters
;;  2. Every five seconds check for state/status changes and print the info
;;

(declare (uses mtargs))
(declare (uses rmt))
(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses commonmod))

(use srfi-1 posix srfi-69 srfi-18 regex defstruct)

(use trace)
;; (trace-call-sites #t)

(declare (uses margs))
(declare (uses rmt))
(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses commonmod))
(import commonmod)
(import commonmod
	(prefix mtargs args:))

(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "db_records.scm")

(define origargs (cdr (argv)))
(define remargs (args:get-args
︙

Modified tdb.scm from [0211217236] to [a4bdcfd23f].

︙
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

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








-
-
-
-
-

+







+
+
+
+
+
+
+
-
+
+
+








;;
;;======================================================================

;;======================================================================
;; Database access
;;======================================================================

(require-extension (srfi 18) extras tcp)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

(declare (unit tdb))
(declare (uses debugprint))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))
(declare (uses db))
(declare (uses commonmod))
(declare (uses mtargs))

(require-extension (srfi 18) extras tcp)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

(import commonmod)
(import commonmod
	debugprint
	(prefix mtargs args:))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

;;======================================================================
︙

Modified tests.scm from [b17b9fa8b7] to [d000d0a092].

︙
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

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








+








+



-
+
+
+








;; Tests
;;======================================================================

(declare (unit tests))
(declare (uses lock-queue))
(declare (uses db))
(declare (uses tdb))
(declare (uses debugprint))
(declare (uses common))
(declare (uses commonmod))
;; (declare (uses dcommon)) ;; needed for the steps processing
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
(declare (uses server))
;;(declare (uses stml2))
(declare (uses mtargs))

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
(import (prefix sqlite3 sqlite3:))
(import commonmod)
(import commonmod
	(prefix mtargs args:)
	debugprint)
(require-library stml)

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
︙

Modified tree.scm from [95903e1b12] to [a9244696cf].

︙
16
17
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

16
17
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








+
















-
+
+








;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (unit tree))
(declare (uses mtargs))
(declare (uses debugprint))
(declare (uses launch))
;; (declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
(declare (uses server))
;; (declare (uses synchash))
(declare (uses dcommon))

(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))

(import (prefix mtargs args:))
(import (prefix mtargs args:)
	debugprint)

(include "megatest-version.scm")
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")

;;======================================================================
︙

This page was generated in about 0.174s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00