Megatest

Changes On Branch f308bbcbc0acfe5a
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

Changes In Branch v1.80-reshape-no-debugprint Excluding Merge-Ins

This is equivalent to a diff from a51a5d6058 to f308bbcbc0

2023-01-31
08:23
Rearranged imports and uses and now past the dreaded can't import debugprint. check-in: 474192c412 user: matt tags: v1.80-reshape
06:47
Re-arranged uses and imports and it worked better Leaf check-in: f308bbcbc0 user: matt tags: v1.80-reshape-no-debugprint
2023-01-30
22:06
removed all imports of debugprint and still can't run megatest exe check-in: 5de6734970 user: matt tags: v1.80-reshape-no-debugprint
20:20
wip check-in: a51a5d6058 user: matt tags: v1.80-reshape
2023-01-29
22:01
wip-no-compile check-in: 9f479c2454 user: matt tags: v1.80-reshape

Modified Makefile from [7f2dc43cfa] to [6b21814662].

︙
27
28
29
30
31
32
33
34

35
36

37
38
39
40
41

42
43
44
45
46
47
48

27
28
29
30
31
32
33

34
35

36
37
38
39
40

41
42
43
44
45
46
47
48








-
+

-
+




-
+








           ezsteps.scm lock-queue.scm api.scm subrun.scm		\
           portlogger.scm archive.scm env.scm diff-report.scm		\
           cgisetup/models/pgdb.scm

# server.scm http-transport.scm client.scm rmt.scm

# module source files
MSRCFILES = dbfile.scm debugprint.scm mtargs.scm commonmod.scm dbmod.scm \
MSRCFILES = dbfile.scm mtargs.scm commonmod.scm dbmod.scm \
            configfmod.scm servermod.scm clientmod.scm rmtmod.scm        \
            artifacts.scm apimod.scm
            artifacts.scm apimod.scm # debugprint.scm

all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut

# dbmod.import.o is just a hack here
mofiles/dbfile.o mofiles/clientmod.o mofiles/dbmod.o mofiles/rmtmod.o : mofiles/debugprint.o mofiles/commonmod.o # dbmod.import.o
mofiles/dbfile.o mofiles/clientmod.o mofiles/dbmod.o mofiles/rmtmod.o : mofiles/commonmod.o # dbmod.import.o mofiles/debugprint.o
db.o : dbmod.import.o
mofiles/debugprint.o : mofiles/mtargs.o
mofiles/servermod.o  : mofiles/artifacts.o
mofiles/rmtmod.o     : mofiles/apimod.o

# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
︙
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187

173
174
175
176
177
178
179

180
181
182
183
184
185
186
187








-
+








tests.o db.o launch.o runs.o dashboard-tests.o				\
dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o	\
monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm

tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o  : run_records.scm

db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm
db.o api.o : mofiles/dbmod.o mofiles/dbfile.o mofiles/debugprint.o mofiles/commonmod.o dbmod.import.o
db.o api.o : mofiles/dbmod.o mofiles/dbfile.o mofiles/commonmod.o dbmod.import.o # mofiles/debugprint.o

# tests.o tasks.o dashboard-tasks.o : task_records.scm

runs.o : test_records.scm

mofiles-made : $(MOFILES)
	make $(MOIMPFILES)
︙

Modified api.scm from [fb1ad3313e] to [b16e9ba59b].

︙
24
25
26
27
28
29
30
31

32
33
34
35
36


37
38
39
40
41
42
43

24
25
26
27
28
29
30

31
32
33
34
35

36
37
38
39
40
41
42
43
44








-
+




-
+
+









(declare (unit api))
(declare (uses rmtmod))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses tasks))
(declare (uses debugprint))
;; (declare (uses debugprint))

(import dbmod)
(import dbfile)
(import rmtmod
	debugprint)
	;; debugprint
	)

(define *db-write-mutexes* (make-hash-table))

;; These are called by the server on recipt of /api calls
;;    - keep it simple, only return the actual result of the call, i.e. no meta info here
;;
;;    - returns #( flag result )
︙

Modified archive.scm from [7a56d0b0c3] to [2d608c708c].

︙
19
20
21
22
23
24
25
26

27
28
29
30
31

32
33
34
35
36
37
38

19
20
21
22
23
24
25

26
27
28
29
30

31
32
33
34
35
36
37
38








-
+




-
+








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

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

(declare (unit archive))
(declare (uses db))
(declare (uses common))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(import debugprint)
;; (import debugprint)

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

;; NOT CURRENTLY USED
;;
︙

Modified clientmod.scm from [cfb1e9f3ec] to [ccd4bc7182].

︙
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

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








-
+














-
+








;;(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 clientmod))
(declare (uses servermod))
(declare (uses artifacts))
(declare (uses debugprint))
;; (declare (uses debugprint))

(module clientmod
*

(import scheme
	chicken

	posix
	data-structures
	srfi-18
	typed-records

	artifacts
	servermod
	debugprint
	;; debugprint
	)

(defstruct con ;; client connection
  (hdir       #f) ;; this is the directory sdir/serverhost.serverpid
  (sdir       #f)
  (obj-to-str #f)
  (str-to-obj #f)
︙

Modified common.scm from [edacec5a50] to [447b601023].

︙
25
26
27
28
29
30
31
32

33
34
35


36
37
38
39
40
41
42

25
26
27
28
29
30
31

32
33
34

35
36
37
38
39
40
41
42
43








-
+


-
+
+








     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     pkts (prefix dbi dbi:)
     )

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

(import commonmod
	debugprint)
	;; debugprint
	)

(include "common_records.scm")


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

Modified commonmod.scm from [837b476e48] to [6567806c42].

︙
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35

21
22
23
24
25
26
27

28
29
30
31
32
33
34
35








-
+








(declare (unit commonmod))

(use srfi-69)

(module commonmod
	*

(import scheme chicken data-structures extras files)
(import scheme chicken data-structures extras files ports)
(import (prefix sqlite3 sqlite3:)
	posix typed-records srfi-18 srfi-69
	md5 message-digest
	regex srfi-1)

;;======================================================================
;; CONTENTS
︙
216
217
218
219
220
221
222
223
224





















































































































































225
226
227
228

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
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





;;
(define (get-cfg-areas cfgdat)
  (let ((adat (get-section cfgdat "areas")))
    (map (lambda (entry)
	   `(,(car entry) . 
	     ,(val->alist (cadr entry))))
	 adat)))

;;======================================================================
;; debugprint
;;======================================================================

;;======================================================================
;; debug stuff
;;======================================================================

(define verbosity (make-parameter '()))
(define *default-log-port*  (current-error-port))
(define debug:print-logger (make-parameter #f)) ;; set to a proc to call on every logging print
	 
(define (debug:setup debug debug-noprop)
  (let ((debugstr (or debug        ;; (args:get-arg "-debug")
      		      debug-noprop ;; (args:get-arg "-debug-noprop")
      		      (get-environment-variable "MT_DEBUG_MODE"))))
    (verbosity (debug:calc-verbosity debugstr 'q))
    (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))(verbosity 1))
    (if (and (not debug-noprop) ;; (args:get-arg "-debug-noprop")
      	     (or debug          ;; (args:get-arg "-debug")
      		 (not (get-environment-variable "MT_DEBUG_MODE"))))
      	(setenv #;set-environment-variable! "MT_DEBUG_MODE" (if (list? (verbosity))
      				    (string-intersperse (map conc (verbosity)) ",")
      				    (conc (verbosity)))))))

;; 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:print . params) #f)
;; (define (debug:print-info . params) #f)
;; 
;; (define (set-functions dbgp dbgpinfo)
;;   (set! debug:print dbgp)
;;   (set! debug:print-info dbgpinfo))

;;======================================================================
;; 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 arg) ;; arg is 'v (verbose) or 'q (quiet)
  (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))))
	       ((eq? arg 'v)   2) ;; verbose
	       ((eq? arg 'q)   0) ;; quiet
	       (else                   1))))
    (verbosity 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)
  (let* ((vb (verbosity)))
    (cond
     ((and (number? vb)   ;; number number
	   (number? n))
      (<= n vb))
     ((and (list? vb)     ;; list   number
	   (number? n))
      (member n vb))
     ((and (list? vb)     ;; list   list
	   (list? n))
      (not (null? (lset-intersection! eq? vb n))))
     ((and (number? vb)
	   (list? n))
      (member vb n))
     (else #f))))

(define (debug:handle-remote-logging params)
  (if (debug:print-logger) ;; NOTE: turn params into string to keep things simple for now
      ((debug:print-logger)(conc "REMOTE ("(get-host-name)", pid="(current-process-id)") "
				 (string-intersperse (map conc params) " ") "; "
				 (string-intersperse (command-line-arguments) " ")))))

(define debug:enable-timestamp (make-parameter #t))

(define (debug:timestamp)
  (if (debug:enable-timestamp)
      (conc (time->string 
	     (seconds->local-time (current-seconds)) "%H:%M:%S") " ")
      ""))

  (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 (debug:timestamp) params)
	  ;; (debug:handle-remote-logging params)
	  )))
  #t ;; only here to make remote stuff happy. It'd be nice to fix that ...
  )

(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 ()
	  (apply print "ERROR: " (debug:timestamp) params)
	  ;; (debug:handle-remote-logging (cons "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: " (debug:timestamp) 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 ()
	  (apply print "INFO: (" n ") "(debug:timestamp) params) ;; res)
	  ;; (debug:handle-remote-logging (cons "INFO: " params))
	  ))))

(define (debug:print-warn n e . params)
  (if (debug:debug-mode n)
      (with-output-to-port (if (port? e) e (current-error-port))
	(lambda ()
	  (apply print "WARN: (" n ") " (debug:timestamp) params) ;; res)
	  ;; (debug:handle-remote-logging (cons "WARN: " params))
	  ))))

;;======================================================================
;; misc stuff
;;======================================================================

)

Modified configf.scm from [a8ff1d05bd] to [3bd7d5954f].

︙
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








-
+



-
+








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

(use regex regex-case matchable) ;;  directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses keys))
(declare (uses debugprint))
;; (declare (uses debugprint))

(include "common_records.scm")

(import debugprint)
;; (import debugprint)

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

Modified configfmod.scm from [5f13eb2f6f] to [932c929ace].

︙
16
17
18
19
20
21
22
23

24
25
26
27
28
29
30

16
17
18
19
20
21
22

23
24
25
26
27
28
29
30








-
+








;;     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 configfmod))
(declare (uses mtargs))
(declare (uses debugprint))
;; (declare (uses debugprint))
;; (declare (uses keysmod))

(module configfmod
*	

(import srfi-1
︙
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56

42
43
44
45
46
47
48

49
50
51
52
53
54
55
56








-
+








;;	chicken.process-context
;;	chicken.process-context.posix
;;	chicken.sort
;;	chicken.string
;;	chicken.time
;;	chicken.eval
;;	
	debugprint
;;	debugprint
	(prefix mtargs args:)
;;	pkts
;;	keysmod
;;
;;	(prefix base64 base64:)
;;	(prefix dbi dbi:)
;;	(prefix sqlite3 sqlite3:)
︙

Modified dashboard-context-menu.scm from [e159de1324] to [11413d9f5f].

︙
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51

52
53
54
55
56
57
58

37
38
39
40
41
42
43

44
45
46
47
48
49
50

51
52
53
54
55
56
57
58








-
+






-
+








(declare (uses db))
(declare (uses gutils))
(declare (uses rmtmod))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
(declare (uses debugprint))
;; (declare (uses debugprint))


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

(import debugprint)
;; (import 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 [65ea816136] to [b054f12cf1].

︙
36
37
38
39
40
41
42
43

44
45
46
47
48
49

50
51
52
53
54
55
56

36
37
38
39
40
41
42

43
44
45
46
47
48

49
50
51
52
53
54
55
56








-
+





-
+








(declare (uses db))
(declare (uses gutils))
(declare (uses rmtmod))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(import debugprint)
;; (import debugprint)

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

(define *dashboard-comment-share-slot* #f)
︙

Modified dashboard.scm from [0d8f853388] to [e79a58e22f].

︙
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

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








-
+









-
+








(declare (uses tree))
(declare (uses dcommon))
(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
(declare (uses mt))
(declare (uses dbfile))        
(declare (uses debugprint))
;; (declare (uses debugprint))

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

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

(import debugprint)
;; (import debugprint)

(dbfile:db-init-proc db:initialize-main-db)

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version 
              " license GPL, Copyright (C) Matt Welland 2012-2017
︙
571
572
573
574
575
576
577
578

579
580
581
582
583
584
585

571
572
573
574
575
576
577

578
579
580
581
582
583
584
585








-
+








	3)))

(define (get-curr-sort)
  (vector-ref *tests-sort-options* *tests-sort-reverse*))

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

(debug:setup)
(debug:setup (args:get-arg "-debug")(args:get-arg "-debug-noprop"))

;; (define uidat #f)

(define-inline (dboard:uidat-get-keycol  vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header  vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))
︙

Modified db.scm from [da2478eb1d] to [4add2c7e8c].

︙
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

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








+

-
+
















+
-
+
+








     z3
     typed-records
     matchable
     files)

(declare (unit db))
(declare (uses common))
(declare (uses commonmod))
(declare (uses dbmod))
(declare (uses debugprint))
;; (declare (uses debugprint))
(declare (uses dbfile))
(declare (uses keys))
(declare (uses ods))
;; (declare (uses client))
(declare (uses mt))

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

(define *number-of-writes* 0)
(define *number-non-write-queries* 0)

(import dbmod
	dbfile
	commonmod
	debugprint)
	;; debugprint
	)

;; record for keeping state,status and count for doing roll-ups in
;; iterated tests
;;
(defstruct dbr:counts
  (state #f)
  (status #f)
︙

Modified dbfile.scm from [bea959c089] to [23a7d02699].

︙
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

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








-
+



















-
+








;; 
;;     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 dbfile))
(declare (uses debugprint))
;; (declare (uses debugprint))
(declare (uses commonmod))

(module dbfile
	*
	
  (import scheme
	  chicken
	  data-structures
	  extras
	  matchable)
  
(import (prefix sqlite3 sqlite3:)
	posix typed-records srfi-18 srfi-1
	srfi-69
	stack
	files
	ports

	commonmod
	debugprint
	;; debugprint
	)

;;======================================================================
;;  R E C O R D S
;;======================================================================

;; a single Megatest area with it's multiple dbs is
︙

Modified dbmod.scm from [c1b3b278a4] to [d8a82d564f].

︙
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








-
+
+
















-
+








;; 
;;     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 dbmod))
(declare (uses debugprint))
(declare (uses commonmod))
;; (include "debugprint.scm")

(module dbmod
	*
	
(import scheme
	chicken
	ports
	s11n
	z3
	
	data-structures
	extras
	(prefix base64 base64:)
	message-digest
	regex

	debugprint
	commonmod ;; debugprint
	)

(import (prefix sqlite3 sqlite3:)
	posix typed-records srfi-18
	srfi-69)

(define (db:run-id->dbname run-id)
︙

Modified dcommon.scm from [960040782d] to [93c134c5ac].

︙
26
27
28
29
30
31
32
33

34
35
36

37
38
39
40
41
42
43

26
27
28
29
30
31
32

33
34
35

36
37
38
39
40
41
42
43








-
+


-
+








(use regex typed-records matchable)

(declare (unit dcommon))

(declare (uses gutils))
(declare (uses db))
(declare (uses commonmod))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

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

Modified diff-report.scm from [350245269f] to [dcde58527c].

︙
15
16
17
18
19
20
21
22

23
24
25
26
27
28

29
30
31
32
33
34
35

15
16
17
18
19
20
21

22
23
24
25
26
27

28
29
30
31
32
33
34
35








-
+





-
+








;;     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 rmtmod))
(declare (uses debugprint))
;; (declare (uses debugprint))
         
(include "common_records.scm")
(use matchable)
(use fmt)
(use ducttape-lib)
(import debugprint)
;; (import debugprint)

(define css "")

(define (diff:tests-mindat->hash tests-mindat)
  (let* ((res (make-hash-table)))
    (for-each
     (lambda (item)
︙

Modified env.scm from [2156bd5c58] to [b700c7de78].

︙
15
16
17
18
19
20
21
22

23
24
25
26

27
28
29
30
31
32
33

15
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 (unit env))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(import debugprint)
;; (import debugprint)

(define (env:open-db fname)
  (let* ((db-exists (common:file-exists? fname))
	 (db        (open-database fname)))
    (if (not db-exists)
	(begin
	  (exec (sql db "CREATE TABLE envvars (
︙

Modified ezsteps.scm from [e652536dac] to [7e870291eb].

︙
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46

23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46








-
+








-
+








     z3 csv typed-records pathname-expand matchable)

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

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

(import debugprint)
;; (import debugprint)
;;(rmt:get-test-info-by-id run-id test-id) -> testdat

;; TODO: deprecate me in favor of ezsteps.scm
;;
(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat)
  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
	 (stepinfo       (cadr ezstep))
︙

Modified genexample.scm from [83a6a2da50] to [27926430b4].

︙
15
16
17
18
19
20
21
22

23
24
25

26
27
28
29
30
31
32

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 genexample))
(declare (uses debugprint))
;; (declare (uses debugprint))

(use posix regex matchable)
(import debugprint)
;; (import 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 items.scm from [b819f8ae5b] to [a9b749fc70].

︙
19
20
21
22
23
24
25
26

27
28
29
30

31
32
33
34
35
36
37

19
20
21
22
23
24
25

26
27
28
29

30
31
32
33
34
35
36
37








-
+



-
+









;; (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 debugprint))

(include "common_records.scm")

(import debugprint)
;; (import debugprint)

;; Puts out all combinations
(define (process-itemlist hierdepth curritemkey itemlist)
  (let ((res '()))
    (if (not hierdepth)
	(set! hierdepth (length itemlist)))
    (let loop ((hed (car itemlist))
︙

Modified keys.scm from [d9a1882f80] to [7667066c63].

︙
19
20
21
22
23
24
25
26

27
28
29
30
31

32
33
34
35
36
37
38

19
20
21
22
23
24
25

26
27
28
29
30

31
32
33
34
35
36
37
38








-
+




-
+








 
;;======================================================================
;; Run keys, these are used to hierarchially organise tests and run areas
;;======================================================================

(declare (unit keys))
(declare (uses common))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(import debugprint)
;; (import debugprint)
	

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

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

Modified launch.scm from [fed129a191] to [953b075aa2].

︙
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44

45
46
47
48
49
50
51

30
31
32
33
34
35
36

37
38
39
40
41
42
43

44
45
46
47
48
49
50
51








-
+






-
+









(declare (unit launch))
(declare (uses subrun))
(declare (uses common))
(declare (uses configf))
(declare (uses db))
(declare (uses ezsteps))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(import debugprint)
;; (import debugprint)

;;======================================================================
;; ezsteps
;;======================================================================

;; ezsteps were going to be coded as
;; stepname[,predstep1,predstep2 ...] [{VAR1=first,second,third}] command to execute
︙

Modified lock-queue.scm from [8e6c749c60] to [1916682e05].

︙
15
16
17
18
19
20
21
22

23
24
25

26
27
28
29
30
31
32

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 lock-queue))
(declare (uses common))
(declare (uses tasks))
(declare (uses debugprint))
;; (declare (uses debugprint))

(use (prefix sqlite3 sqlite3:) srfi-18)
(import debugprint)
;; (import debugprint)

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

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

Modified megatest.scm from [555218ae3b] to [a14a18a501].

︙
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

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








+
+
+
+

+
+
+
+
+



















-
+



-
-
+
-
-
-
-
+
+
+






-
+
-

+
+

+
-
+









;; (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 commonmod))
(declare (uses commonmod.import))
(declare (uses dbfile))
(declare (uses dbfile.import))

;; (declare (uses megatest-version))
(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 dbmod.import))
(declare (uses rmtmod))
(declare (uses clientmod))
(declare (uses servermod))
(declare (uses commonmod))
(declare (uses commonmod.import))
;; (declare (uses commonmod.import))
(declare (uses dbfile))
(declare (uses dbfile.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
;; (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
(import commonmod
	commonmod
	dbfile
	
	dbmod
	servermod
	;; debugprint.import
	debugprint
	;; debugprint
	)

(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")
︙
661
662
663
664
665
666
667
668

669
670
671
672
673
674
675

670
671
672
673
674
675
676

677
678
679
680
681
682
683
684








-
+








    (debug:print 0 *default-log-port* (string-intersperse (argv) " ")))


;;======================================================================
;; Misc setup stuff
;;======================================================================

(debug:setup)
(debug:setup (args:get-arg "-debug")(args:get-arg "-debug-noprop"))

(if (args:get-arg "-logging")(set! *logging* #t))

;;(if (debug:debug-mode 3) ;; we are obviously debugging
;;    (set! open-run-close open-run-close-no-exception-handling))

(if (args:get-arg "-itempatt")
︙

Modified mt.scm from [1abbf767e0] to [2eb794b360].

︙
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41

42
43
44
45
46
47
48

26
27
28
29
30
31
32

33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48








-
+







-
+








(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses servermod))
(declare (uses runs))
(declare (uses rmtmod))
;; (declare (uses filedb))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(import debugprint)
;; (import debugprint)

;; This is the Megatest API. All generally "useful" routines will be wrapped or extended
;; here.

;;======================================================================
;;  R U N S
;;======================================================================
︙

Modified mtut.scm from [f9bdb0fdb0] to [df6eb07f0f].

︙
28
29
30
31
32
33
34
35

36
37
38
39

40
41
42
43
44
45
46

28
29
30
31
32
33
34

35
36
37
38

39
40
41
42
43
44
45
46








-
+



-
+








     (prefix sqlite3 sqlite3:)
     nanomsg)

(declare (uses common))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
(declare (uses debugprint))
;; (declare (uses debugprint))

(use ducttape-lib)

(import debugprint)
;; (import debugprint)

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

(require-library stml)

;; stuff for the mapper and checker functions
;;
︙

Modified newdashboard.scm from [db5c39b7a4] to [25e748f7c8].

︙
34
35
36
37
38
39
40
41

42
43
44
45
46
47
48

49
50
51
52
53
54
55

34
35
36
37
38
39
40

41
42
43
44
45
46
47

48
49
50
51
52
53
54
55








-
+






-
+









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

;; (declare (uses tree))
;; 
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
(import debugprint)
;; (import debugprint)

(define help (conc 
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright (C) Matt Welland 2011

Usage: dashboard [options]
︙

Modified portlogger.scm from [59aa832bb1] to [754b691051].

︙
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








-
-
+
+








(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 db))
(declare (uses debugprint))
(import debugprint)
;; (declare (uses debugprint))
;; (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
︙

Modified process.scm from [4050043a66] to [60c5f21e59].

︙
20
21
22
23
24
25
26
27

28
29

30
31
32
33
34
35
36

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))
;; (declare (uses debugprint))

(import 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 [00e4366063] to [d0b4ed73a0].

︙
20
21
22
23
24
25
26
27

28
29
30
31
32
33

34
35
36
37
38
39
40

20
21
22
23
24
25
26

27
28
29
30
31
32

33
34
35
36
37
38
39
40








-
+





-
+









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

(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(declare (uses dbfile))
(declare (uses debugprint))
;; (declare (uses debugprint))

(include "common_records.scm")
;; (declare (uses rmtmod))

(import dbfile
	debugprint
	;; debugprint
	) ;; rmtmod)

;; ;;
;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;; ;;
;; 
;; ;; generate entries for ~/.megatestrc with the following
︙

Modified rmtmod.scm from [32ffde6ac2] to [c9947e40de].

︙
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








-
+

+
+


















-
+









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

(declare (unit rmtmod))
(declare (uses commonmod))
(declare (uses clientmod))
(declare (uses dbmod))
(declare (uses debugprint))
;; (declare (uses debugprint))
(declare (uses apimod))

;; (include "debugprint.scm")

(module rmtmod
*

(import scheme
	chicken
	data-structures
	posix
	;; regex
	srfi-1
	srfi-18
	srfi-69
	extras

	commonmod
	clientmod
	dbmod
	apimod
	debugprint
	;; debugprint
	)

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
︙

Modified runconfig.scm from [6913a95308] to [606c33435c].

︙
18
19
20
21
22
23
24
25

26
27

28

29
30
31
32
33
34
35

18
19
20
21
22
23
24

25
26
27
28

29
30
31
32
33
34
35
36








-
+


+
-
+








;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================

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

(use format directory-utils)

(import debugprint)
;; (import 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 [db1439c273] to [626d61ee99].

︙
27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42

43
44
45
46
47
48
49

27
28
29
30
31
32
33

34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
49








-
+







-
+








(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses servermod))
(declare (uses mt))
(declare (uses archive))
;; (declare (uses filedb))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(import debugprint)
;; (import debugprint)
;; (include "debugger.scm")

;; use this struct to facilitate refactoring
;;

(defstruct runs:dat
  reglen regfull
︙

Modified servermod.scm from [b3e225a5e9] to [23cc0f45b6].

︙
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

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








-
+




















-
+








;; 
;;     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 servermod))
(declare (uses artifacts))
(declare (uses debugprint))
;; (declare (uses debugprint))

(use md5 message-digest posix typed-records extras)

(module servermod
*

(import scheme
	chicken

	extras
	md5
	message-digest
	ports
	posix
	srfi-18

	typed-records
	data-structures

	artifacts
	debugprint
	;; debugprint
	)

(defstruct srv
  (areapath #f)
  (host     #f)
  (pid      #f)
  (type     #f)
︙

Modified subrun.scm from [68aa532b1d] to [da48a109f1].

︙
25
26
27
28
29
30
31
32

33
34
35
36
37
38

39
40
41
42
43
44
45

25
26
27
28
29
30
31

32
33
34
35
36
37

38
39
40
41
42
43
44
45








-
+





-
+








;;(declare (uses items))
;;(declare (uses runconfig))
;;(declare (uses tests))
;;(declare (uses server))
(declare (uses mt))
;;(declare (uses archive))
;; (declare (uses filedb))
(declare (uses debugprint))
;; (declare (uses debugprint))

(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 debugprint)
;; (import 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 [3a4630abf8] to [bdfbc420bf].

︙
23
24
25
26
27
28
29
30

31
32
33

34
35
36
37
38
39
40

23
24
25
26
27
28
29

30
31
32

33
34
35
36
37
38
39
40








-
+


-
+









(declare (unit tasks))
(declare (uses dbfile))
(declare (uses db))
(declare (uses rmtmod))
(declare (uses common))
(declare (uses pgdb))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(include "db_records.scm")

;;======================================================================
;; Tasks db
︙

Modified tdb.scm from [c43cba4b5d] to [5959cc0a2c].

︙
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44

45
46
47
48
49
50
51

30
31
32
33
34
35
36

37
38
39
40
41
42
43

44
45
46
47
48
49
50
51








-
+






-
+








(declare (unit tdb))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses clientmod))
(declare (uses mt))
(declare (uses db))
(declare (uses debugprint))
;; (declare (uses debugprint))

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

(import debugprint)
;; (import debugprint)

;;======================================================================
;;
;; T E S T   D A T A B A S E S
;;
;;======================================================================
︙

Modified tests.scm from [cbdf45c29c] to [07913f4c86].

︙
30
31
32
33
34
35
36
37

38
39

40
41
42
43
44
45
46

30
31
32
33
34
35
36

37
38

39
40
41
42
43
44
45
46








-
+

-
+








(declare (uses commonmod))
;; (declare (uses dcommon)) ;; needed for the steps processing
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
(declare (uses servermod))
;;(declare (uses stml2))
(declare (uses debugprint))
;; (declare (uses debugprint))

(import debugprint)
;; (import debugprint)

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

(include "common_records.scm")
︙

Modified tree.scm from [018afa4bfc] to [fbe7ce81da].

︙
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45

46
47
48
49
50
51
52

31
32
33
34
35
36
37

38
39
40
41
42
43
44

45
46
47
48
49
50
51
52








-
+






-
+








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

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

(import debugprint)
;; (import debugprint)

;;======================================================================
;; T R E E   S T U F F 
;;======================================================================

;; path is a list of nodes, each the child of the previous
;; this routine returns the id so another node can be added
︙

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