Megatest

Check-in [3528bbcf9e]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-tcp-inmem
Files: files | file ages | folders
SHA1: 3528bbcf9e98db7508e54b8e6166dc30f1bf1d87
User & Date: matt on 2023-02-15 19:57:53
Other Links: branch diff | manifest | tags
Context
2023-02-15
21:37
wip check-in: 0588f96563 user: matt tags: v1.80-tcp-inmem
19:57
wip check-in: 3528bbcf9e user: matt tags: v1.80-tcp-inmem
19:28
wip. compiles. check-in: 24ddf5d235 user: matt tags: v1.80-tcp-inmem
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified margs.scm from [cc1616820d] to [7a5ab19394].

︙
21
22
23
24
25
26
27










28
29
30
31
32
33
34

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44








+
+
+
+
+
+
+
+
+
+









(define args:arg-hash (make-hash-table))

(define (args:get-arg arg . default)
  (if (null? default)
      (hash-table-ref/default args:arg-hash arg #f)
      (hash-table-ref/default args:arg-hash arg (car default))))

;; get an arg as a number
(define (args:get-arg-number arg . default)
  (let* ((val-str (args:get-arg arg))
	 (val     (if val-str (string->number val-str) #f)))
    (if val
	val
	(if (null? default)
	    #f
	    default))))

(define (args:any? . args)
  (not (null? (filter (lambda (x) x)
		      (map args:get-arg args)))))

(define (args:get-arg-from ht arg . default)
  (if (null? default)
︙

Modified megatest.scm from [bfdf2b502e] to [9c43e220e5].

︙
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

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








+
+


















-
-
-
-
-
+
+
+
+
+








-
+
+


-
+








(define (toplevel-command . a) #f)

(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses margs))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses client))
(declare (uses tests))
(declare (uses genexample))
;; (declare (uses daemon))

(declare (uses db))
;; (declare (uses dcommon))

(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbmod.import))
(declare (uses dbfile))
(declare (uses dbfile.import))
(declare (uses tcp-transport))
(declare (uses dbfile))
(declare (uses dbfile.import))
(declare (uses dbmod))
(declare (uses dbmod.import))
(declare (uses tcp-transportmod))
;; (declare (uses debugprint))
;; (declare (uses debugprint.import))
;; (declare (uses mtargs))
;; (declare (uses mtargs.import))

;; (declare (uses ftail))
;; (import ftail)

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

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

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

Modified mtargs/mtargs.scm from [9b07b2ae01] to [49b76da6ef].

︙
16
17
18
19
20
21
22

23
24
25
26
27
28
29

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








+








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


(module mtargs
    (
     arg-hash
     get-arg
     get-arg-number
     get-arg-from
     get-args
     usage
     print-args
     any-defined?
     )
︙
40
41
42
43
44
45
46










47
48
49
50
51
52
53

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64








+
+
+
+
+
+
+
+
+
+








(define usage (make-parameter print))
(define arg-hash (make-hash-table))

(define (get-arg arg . default)
  (if (null? default)
      (hash-table-ref/default arg-hash arg #f)
      (hash-table-ref/default arg-hash arg (car default))))

;; get an arg as a number
(define (get-arg-number arg . default)
  (let* ((val-str (get-arg arg))
	 (val     (if val-str (string->number val-str) #f)))
    (if val
	val
	(if (null? default)
	    #f
	    default))))

(define (any-defined? . args)
  (not (null? (filter (lambda (x) x)
		      (map get-arg args)))))

;; (define any any-defined?)
︙

Modified tcp-transportmod.scm from [4ba3510aa8] to [b0c618b157].

︙
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171

152
153
154
155
156
157
158






159
160
161
162
163
164
165








-
-
-
-
-
-








	(begin
	  (tt:start-tcp-server ttdat) ;; start the tcp-server which applies handler to incoming data
	  (tt:keep-running ttdat dbfname))
	(begin
	  (debug:print 0 *default-log-port* "INFO: found server(s) already running for db "dbfname", "(string-intersperse servers ",")" Exiting.")
	  (exit)))))

((make-tcp-server 
  (tcp-listen 6504) 
  (lambda () 
    (write-line (seconds->string (current-seconds)))))
 #t)

;; find a port and start tcp-server
;;
(define (tt:start-tcp-server ttdat)
  (setup-listener ttdat)
  (let* ((socket   (tt-srv-socket ttdat))
	 (handler  (tt-srv-handler    ttdat)))
    ((make-tcp-server socket handler)
︙

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