Megatest

Check-in [3333a49fd4]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:wip, more tests passing
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.0001
Files: files | file ages | folders
SHA1: 3333a49fd45a91a4592956f3193141d76a1cc4be
User & Date: matt on 2022-01-03 18:24:07
Other Links: branch diff | manifest | tags
Context
2022-01-03
18:31
Switch to s11n for serialization in place of read/write. check-in: 939ef5990f user: matt tags: v2.0001
18:24
wip, more tests passing check-in: 3333a49fd4 user: matt tags: v2.0001
17:38
wip. rmt:get-keys now works check-in: 3541d27302 user: matt tags: v2.0001
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified tests/tests.scm from [7467445dd0] to [3fa28c6a70].

︙︙
47
48
49
50
51
52
53










54
55
56
57
58
59
60

;; read in all the _record files
;; (let ((files (glob "*_records.scm")))
;;   (for-each
;;    (lambda (file)
;;      (print "Loading " file)
;;      (load file))
;;    files))











(let* ((unit-test-name (list-ref (argv) 4))
       (fname          (conc "../unittests/" unit-test-name ".scm")))
  (if (file-exists? fname)
      (load fname)
      (print "ERROR: Unit test " unit-test-name " not found in unittests directory")))









>
>
>
>
>
>
>
>
>
>








47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

;; read in all the _record files
;; (let ((files (glob "*_records.scm")))
;;   (for-each
;;    (lambda (file)
;;      (print "Loading " file)
;;      (load file))
;;    files))

(define-syntax run-in-thread
  (syntax-rules ()
    ((_ body ...)
     (let ((th1 (make-thread (lambda ()
			       body ...)
			     "the thread")))
       (thread-start! th1)
       (thread-join! th1)))))


(let* ((unit-test-name (list-ref (argv) 4))
       (fname          (conc "../unittests/" unit-test-name ".scm")))
  (if (file-exists? fname)
      (load fname)
      (print "ERROR: Unit test " unit-test-name " not found in unittests directory")))

Modified tests/unittests/all-rmt.scm from [3a8e222d0c] to [170e763023].

︙︙
89
90
91
92
93
94
95
96
97

98

99
100
101
102
103
104
105

;; (test-batch rmt:get-latest-host-load
;;             "rmt:get-latest-host-load"
;;             (list (list "localhost"  #t (get-host-name))
;;                   (list "not-a-host" #t "not-a-host"  ))
;;             post-proc: pair?)
;;                                            
;; (test #f #t (list? (rmt:get-changed-record-ids 0)))
;; 
(test #f #f (begin (runs:update-all-test_meta #f) #f))

 

(test #f '("test1" "test2")(sort (alist-ref "tagtwo" (rmt:get-tests-tags) equal?) string<=?))
(test #f '() (rmt:get-key-val-pairs 0))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys-write)) ;; dummy query to force server start
(test #f '() (rmt:get-key-vals 1))
(test #f (vector '("SYSTEM" "RELEASE") '()) (rmt:get-targets))
(test #f "" (rmt:get-target 1))








|
|
>
|
>








89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

;; (test-batch rmt:get-latest-host-load
;;             "rmt:get-latest-host-load"
;;             (list (list "localhost"  #t (get-host-name))
;;                   (list "not-a-host" #t "not-a-host"  ))
;;             post-proc: pair?)
;;                                            
;; (test #f #t (list? (rmt:get-changed-record-ids 0)))
;;

(run-in-thread

 ;; (test #f #f (begin (runs:update-all-test_meta #f) #f)) 
(test #f '("test1" "test2")(sort (alist-ref "tagtwo" (rmt:get-tests-tags) equal?) string<=?))
(test #f '() (rmt:get-key-val-pairs 0))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys-write)) ;; dummy query to force server start
(test #f '() (rmt:get-key-vals 1))
(test #f (vector '("SYSTEM" "RELEASE") '()) (rmt:get-targets))
(test #f "" (rmt:get-target 1))
︙︙
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158

(test #f #t (vector? (rmt:get-runs "%" 10 0 keypatts)))
(test #f '(1)(rmt:get-all-run-ids))
(test #f '()(rmt:get-prev-run-ids 1))
(test #f #t (begin (rmt:lock/unlock-run 1 #t #f "mikey") #t))
(test #f "JUSTFINE" (rmt:get-run-status 1))
(test #f #t (begin (rmt:set-run-status 1 "NOTFINE" msg: "A message") #t))
(test #f #t (begin (rmt:update-run-event_time 1) #t))

;; (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit fields last-runs-update) ;; fields of #f uses default
;;
(let ((keys (rmt:get-keys))
      (rnp  "%")    ;; run name patt
      (tpt  "%/%")) ;; target patt
  (test-batch rmt:get-runs-by-patt
              "rmt:get-runs-by-patt"








|








146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

(test #f #t (vector? (rmt:get-runs "%" 10 0 keypatts)))
(test #f '(1)(rmt:get-all-run-ids))
(test #f '()(rmt:get-prev-run-ids 1))
(test #f #t (begin (rmt:lock/unlock-run 1 #t #f "mikey") #t))
(test #f "JUSTFINE" (rmt:get-run-status 1))
(test #f #t (begin (rmt:set-run-status 1 "NOTFINE" msg: "A message") #t))
(test #f #t (begin (rmt:update-run-event_time 1) #t))
)
;; (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit fields last-runs-update) ;; fields of #f uses default
;;
(let ((keys (rmt:get-keys))
      (rnp  "%")    ;; run name patt
      (tpt  "%/%")) ;; target patt
  (test-batch rmt:get-runs-by-patt
              "rmt:get-runs-by-patt"
︙︙

Modified tests/unittests/basicserver.scm from [d569827954] to [7886f1227c].

︙︙
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

 ;;
 ;; ulex
 ;;
 ;; wait-and-close
 ;; run-listener
 )

(define-syntax run-in-thread
  (syntax-rules ()
    ((_ body ...)
     (let ((th1 (make-thread (lambda ()
			       body ...)
			     "the thread")))
       (thread-start! th1)
       (thread-join! th1)))))


(test #f #t (servdat? (let ((s (make-servdat)))
			  (set! *servdat* s)
			  s)))
(test #f #f (rmt:get-conn *servdat* *toppath* ".db/main.db"))
(test #f #f (rmt:find-main-server *servdat* *toppath* ".db/main.db"))
(define th1 (make-thread (lambda ()








<
<
<
<
<
<
<
<
<








50
51
52
53
54
55
56









57
58
59
60
61
62
63

 ;;
 ;; ulex
 ;;
 ;; wait-and-close
 ;; run-listener
 )











(test #f #t (servdat? (let ((s (make-servdat)))
			  (set! *servdat* s)
			  s)))
(test #f #f (rmt:get-conn *servdat* *toppath* ".db/main.db"))
(test #f #f (rmt:find-main-server *servdat* *toppath* ".db/main.db"))
(define th1 (make-thread (lambda ()
︙︙

Modified tests/unittests/server.scm from [70755134bd] to [49807e069f].

︙︙
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
82
83
84
85
86
87
88
89

 )

(define *db* (db:setup ".db/main.db"))

;; these let me cut and paste from source easily
(define apath *toppath*)
(define dbname ".db/2.db")
(define remote *remotedat*)
(define keyvals  '(("SYSTEM" "a")("RELEASE" "b")))

(test #f #t (rmt:open-main-connection remote apath))
(test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db")))
(test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db")))

(test #f ".db/2.db" (list-ref (rmt:send-receive-real *remotedat* *toppath* ".db/main.db" 'get-server `(,apath ,dbname))
			      6))

(thread-sleep! 2)
(test #f #t (rmt:general-open-connection *remotedat* *toppath* ".db/2.db"))

;; (let loop ((end-time (+ (current-seconds) 61)))
  (test #f #t (list? (rmt:get-servers-info *toppath*)))

  (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
  (test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f)))
  ;; (print "Got here.")

  (test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))

  (test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
  ;; (test #f 2 (rmt:deregister-server *remotedat* *toppath* iface port server-key dbname

  (test #f 2 (rmt:get-count-servers *remotedat* *toppath*))

  (test #f "run2" (rmt:get-run-name-from-id 2))
  (test #f #f     (rmt:send-receive 'get-test-info-by-id 2 '(2 1)))
  
  (test #f #t     (rmt:general-call 'update-cpuload-diskfree 2 1.5 1e6 1))
;;  (if (< (current-seconds) end-time)(loop end-time)))









|



|
|
>
|
<


|











|

|








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
82
83
84
85
86
87
88
89

 )

(define *db* (db:setup ".db/main.db"))

;; these let me cut and paste from source easily
(define apath *toppath*)
(define dbname ".db/2.db")
(define remote *db-serv-info*)
(define keyvals  '(("SYSTEM" "a")("RELEASE" "b")))

(test #f #t (rmt:open-main-connection remote apath))
(test #f #t (conndat? (rmt:get-conn *db-serv-info* *toppath* ".db/main.db")))
(test #f #t (conndat? (rmt:get-conn *db-serv-info* *toppath* ".db/main.db")))
(test #f 'server-started (rmt:send-receive-real *db-serv-info* *toppath* ".db/main.db"
					   'start-server `(,apath ,dbname)))


(thread-sleep! 2)
(test #f #t (rmt:general-open-connection *db-serv-info* *toppath* ".db/2.db"))

;; (let loop ((end-time (+ (current-seconds) 61)))
  (test #f #t (list? (rmt:get-servers-info *toppath*)))

  (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
  (test #f 1 (rmt:send-receive 'register-run #f (list keyvals "run1" "new" "n/a" "justme" #f)))
  ;; (print "Got here.")

  (test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))

  (test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
  ;; (test #f 2 (rmt:deregister-server *db-serv-info* *toppath* iface port server-key dbname

  (test #f 2 (rmt:get-count-servers *db-serv-info* *toppath*))

  (test #f "run2" (rmt:get-run-name-from-id 2))
  (test #f #f     (rmt:send-receive 'get-test-info-by-id 2 '(2 1)))
  
  (test #f #t     (rmt:general-call 'update-cpuload-diskfree 2 1.5 1e6 1))
;;  (if (< (current-seconds) end-time)(loop end-time)))
︙︙

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