Megatest

Check-in [c1e0d8251a]
Login
Overview
Comment:converging on imports done right (but not there yet).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.80-reshape
Files: files | file ages | folders
SHA1: c1e0d8251ab9052806290ed4c7ef982ed7bc80f3
User & Date: matt on 2023-01-31 18:42:52
Other Links: branch diff | manifest | tags
Context
2023-01-31
18:42
converging on imports done right (but not there yet). Leaf check-in: c1e0d8251a user: matt tags: v1.80-reshape
08:23
Rearranged imports and uses and now past the dreaded can't import debugprint. check-in: 474192c412 user: matt tags: v1.80-reshape
Changes

Modified commonmod.scm from [837b476e48] to [fc4f606314].

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
;;======================================================================

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

;; Globals

(define *runremote*           #f)                ;; if set up for server communication this will hold <host port>
;; db stats
(define *db-stats*            (make-hash-table)) ;; hash of vectors < count duration-total >
(define *db-stats-mutex*      (make-mutex))
(define *toppath*             #f)
(define *db-keys*             #f)
(define *keyvals*             #f)








<







41
42
43
44
45
46
47

48
49
50
51
52
53
54
;;======================================================================

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

;; Globals


;; db stats
(define *db-stats*            (make-hash-table)) ;; hash of vectors < count duration-total >
(define *db-stats-mutex*      (make-mutex))
(define *toppath*             #f)
(define *db-keys*             #f)
(define *keyvals*             #f)

Modified db.scm from [da2478eb1d] to [36fb33ffce].

44
45
46
47
48
49
50

51
52
53
54
55
56
57




58
59
60
61
62
63
64
     z3
     typed-records
     matchable
     files)

(declare (unit db))
(declare (uses common))

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







>







>
>
>
>







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
     z3
     typed-records
     matchable
     files)

(declare (unit db))
(declare (uses common))
(declare (uses commonmod))
(declare (uses dbmod))
(declare (uses debugprint))
(declare (uses dbfile))
(declare (uses keys))
(declare (uses ods))
;; (declare (uses client))
(declare (uses mt))
(declare (uses rmtmod))  ;; only needed for *runremote*

(import commonmod
	rmtmod)

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

(define *number-of-writes* 0)

Modified launch.scm from [fed129a191] to [4521e49ae5].

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

(import (prefix base64 base64:))
(import (prefix sqlite3 sqlite3:))

(declare (unit launch))
(declare (uses subrun))
(declare (uses common))

(declare (uses configf))
(declare (uses db))
(declare (uses ezsteps))
(declare (uses debugprint))

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

(import debugprint)



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

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







>










|
>
>







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

(import (prefix base64 base64:))
(import (prefix sqlite3 sqlite3:))

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

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

(import debugprint
	commonmod
	)

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

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

Modified megatest.scm from [9ac2f34ed3] to [166f787e47].

18
19
20
21
22
23
24




25
26
27
28
29
30


31
32
33
34
35
36
37

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

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





(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses debugprint))
(declare (uses debugprint.import))


(declare (uses dbfile))
(declare (uses dbfile.import))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses tests))
(declare (uses genexample))







>
>
>
>






>
>







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

;; (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 megatest-version))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses artifacts))
(declare (uses artifacts.import))
(declare (uses dbfile))
(declare (uses dbfile.import))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses tests))
(declare (uses genexample))
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
(declare (uses env))
(declare (uses diff-report))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbmod.import))
(declare (uses rmtmod))
(declare (uses clientmod))

(declare (uses servermod))

;; (declare (uses mtargs))
;; (declare (uses mtargs.import))

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

(import commonmod
	debugprint
	dbfile
	dbmod
	servermod
	
	)







(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")







>

>













>
>
>
>
>
>







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
82
83
84
85
86
87
88
(declare (uses env))
(declare (uses diff-report))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbmod.import))
(declare (uses rmtmod))
(declare (uses clientmod))
(declare (uses clientmod.import))
(declare (uses servermod))
(declare (uses servermod.import))
;; (declare (uses mtargs))
;; (declare (uses mtargs.import))

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

(import commonmod
	debugprint
	dbfile
	dbmod
	servermod
	
	)

(include "commonmod.import.scm")
(include "artifacts.import.scm")
(include "rmtmod.import.scm")
(include "clientmod.import.scm")
(include "servermod.import.scm")

(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")
2413
2414
2415
2416
2417
2418
2419



2420
2421
2422
2423
2424
2425
2426
	   (else
	    (begin
	      (set! *db* dbstructs)
	      (import extras) ;; might not be needed
	      ;; (import csi)
	      (import readline)
	      (import apropos)



	      (import dbfile)
	      ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...

	      (if *use-new-readline*
		  (begin
		    (install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
		    (current-input-port (make-readline-port "megatest> ")))







>
>
>







2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
	   (else
	    (begin
	      (set! *db* dbstructs)
	      (import extras) ;; might not be needed
	      ;; (import csi)
	      (import readline)
	      (import apropos)
	      (import commonmod)
	      (import rmtmod)
	      (import apimod)
	      (import dbfile)
	      ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...

	      (if *use-new-readline*
		  (begin
		    (install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
		    (current-input-port (make-readline-port "megatest> ")))

Modified rmtmod.scm from [32ffde6ac2] to [609124d701].

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

	commonmod
	clientmod
	dbmod
	apimod
	debugprint
	)


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

;; generate entries for ~/.megatestrc with the following
;;
;;  grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u

;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================



;; if a server is either running or in the process of starting call client:setup
;; else return #f to let the calling proc know that there is no server available
;;
(define (rmt:get-connection-info areapath) ;; TODO: push areapath down.
  (if *runremote*
      *runremote*







>












>
>







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

	commonmod
	clientmod
	dbmod
	apimod
	debugprint
	)


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

;; generate entries for ~/.megatestrc with the following
;;
;;  grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u

;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================

(define *runremote* #f)

;; if a server is either running or in the process of starting call client:setup
;; else return #f to let the calling proc know that there is no server available
;;
(define (rmt:get-connection-info areapath) ;; TODO: push areapath down.
  (if *runremote*
      *runremote*

Modified servermod.scm from [b3e225a5e9] to [e3e9db4225].

191
192
193
194
195
196
197

















198
199
200
201
202
203
204
  (let* ((logd (conc areapath"/logs"))
	 (logf (conc logd"/from-"(get-host.pid #f)".log")))
    (if (not (file-exists? logd))(create-directory logd #t))
    (setenv "NBFAKE_LOG" logf)
    (system (conc "nbfake mtserve -start-dir "areapath))))




















;;======================================================================
;; OLD SERVER STUFF BELOW HERE
;;======================================================================

;; ;; servers start by setting up fs transport
;; ;; and put a flag file for that ASAP.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
  (let* ((logd (conc areapath"/logs"))
	 (logf (conc logd"/from-"(get-host.pid #f)".log")))
    (if (not (file-exists? logd))(create-directory logd #t))
    (setenv "NBFAKE_LOG" logf)
    (system (conc "nbfake mtserve -start-dir "areapath))))


;; oldest server alive determines host then choose random of youngest
;; five servers on that host
;;
;; mode:
;;   best - get best server (random of newest five)
;;   home - get home host based on oldest server
;;   info - print info
(define (server:choose-server areapath #!optional (mode 'best))
  ;; age is current-starttime
  ;; find oldest alive
  ;;   1. sort by age ascending and ping until good
  ;; find alive rand from youngest
  ;;   1. sort by age descending
  ;;   2. take five
  ;;   3. check alive, discard if not and repeat
  ;; first we clean up old server files
  '())

;;======================================================================
;; OLD SERVER STUFF BELOW HERE
;;======================================================================

;; ;; servers start by setting up fs transport
;; ;; and put a flag file for that ASAP.