Megatest

Check-in [fb07933d2a]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Reverted register-test to not be remote in test1
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | test-specific-db
Files: files | file ages | folders
SHA1: fb07933d2aea3419551fe2d7b478df1ee02a751f
User & Date: matt on 2012-10-06 14:25:49
Other Links: branch diff | manifest | tags
Context
2012-10-06
16:40
rpc working on Ubuntu except for rollup check-in: 6747bc6633 user: matt tags: test-specific-db
14:25
Reverted register-test to not be remote in test1 check-in: fb07933d2a user: matt tags: test-specific-db
2012-10-05
17:04
Backed out rpc of register-test, test1,test4 working check-in: 197b642483 user: mrwellan tags: test-specific-db
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [a453d29161] to [dfb1bb5681].

︙
1071
1072
1073
1074
1075
1076
1077
1078

1079
1080
1081
1082
1083
1084
1085

1071
1072
1073
1074
1075
1076
1077

1078
1079
1080
1081
1082
1083
1084
1085








-
+








				      (list fail-count pass-count test-id))
			      *incoming-data*))
  (mutex-unlock! *incoming-mutex*)
  (if *cache-on*
      (debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write")
      (db:write-cached-data)))

(define (cdb:tests-register-test run-id test-name item-path #!key (force-write #f))
(define (cdb:tests-register-test db run-id test-name item-path #!key (force-write #f))
  (let ((item-paths (if (equal? item-path "")
			(list item-path)
			(list item-path ""))))
    (debug:print 4 "INFO: Adding " run-id ", " test-name "/" item-path " for setting pass/fail counts to the queue")
    (mutex-lock! *incoming-mutex*)
    (set! *last-db-access* (current-seconds))
    (set! *incoming-data* (cons (vector 'register-test
︙
1646
1647
1648
1649
1650
1651
1652
1653

1654
1655
1656
1657
1658


1659
1660
1661
1662
1663
1664
1665
1666

1646
1647
1648
1649
1650
1651
1652

1653
1654
1655
1656


1657
1658
1659
1660
1661
1662
1663
1664
1665
1666








-
+



-
-
+
+









  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'cdb:pass-fail-counts host port) test-id fail-count pass-count))
      (cdb:pass-fail-counts test-id fail-count pass-count)))

;; currently forces a flush of the queue
(define (rdb:tests-register-test run-id test-name item-path)
(define (rdb:tests-register-test db run-id test-name item-path)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'cdb:tests-register-test host port) run-id test-name item-path force-write: #t))
      (cdb:tests-register-test run-id test-name item-path force-write: #t)))
	((rpc:procedure 'cdb:tests-register-test host port) db run-id test-name item-path force-write: #t))
      (cdb:tests-register-test db run-id test-name item-path force-write: #t)))

(define (rdb:flush-queue)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'cdb:flush-queue host port)))
      (cdb:flush-queue)))

Modified server.scm from [16954f9f6c] to [69a1ff5b72].

︙
61
62
63
64
65
66
67
68

69
70
71
72
73
74
75

61
62
63
64
65
66
67

68
69
70
71
72
73
74
75








-
+








	  ;; can use this to run most anything at the remote
	  (rpc:publish-procedure! 
	   'remote:run 
	   (lambda (procstr . params)
	     (server:autoremote procstr params)))
	  
	  (rpc:publish-procedure!
	   'serve:login
	   'server:login
	   (lambda (toppath)
	     (set! *last-db-access* (current-seconds))
	     (if (equal? *toppath* toppath)
		 (begin
		   (debug:print 2 "INFO: login successful")
		   #t)
		 #f)))
︙
101
102
103
104
105
106
107
108

109
110

111
112
113
114
115
116
117

101
102
103
104
105
106
107

108
109

110
111
112
113
114
115
116
117








-
+

-
+








	   'cdb:pass-fail-counts
	   (lambda (test-id fail-count pass-count)
	     (debug:print 4 "INFO: Remote call of cdb:pass-fail-counts " test-id " passes: " pass-count " fails: " fail-count)
	     (cdb:pass-fail-counts test-id fail-count pass-count)))

	  (rpc:publish-procedure!
	   'cdb:tests-register-test
	   (lambda (run-id test-name item-path)
	   (lambda (db run-id test-name item-path)
	     (debug:print 4 "INFO: Remote call of cdb:tests-register-test " run-id " testname: " test-name " item-path: " item-path)
	     (cdb:tests-register-test run-id test-name item-path)))
	     (cdb:tests-register-test db run-id test-name item-path)))

	  (rpc:publish-procedure!
	   'cdb:flush-queue
	   (lambda ()
	     (debug:print 4 "INFO: Remote call of cdb:flush-queue")
	     (cdb:flush-queue)))
︙
193
194
195
196
197
198
199
200

201
202
203
204
205
206
207
208

193
194
195
196
197
198
199

200
201
202
203
204
205
206
207
208








-
+









		 (debug:print 0 "   EXCEPTION: " ((condition-property-accessor 'exn 'message) exn))
		 ;; (open-run-close 
		 ;;  (lambda (db . param) 
		 ;;    (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'"))
		 ;;  #f)
		 (set! *runremote* #f))
	       (if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server
			((rpc:procedure 'serve:login host portn) *toppath*))
			((rpc:procedure 'server:login host portn) *toppath*))
		   (begin
		     (debug:print 2 "INFO: Connected to " host ":" port)
		     (set! *runremote* (vector host portn)))
		   (begin
		     (debug:print 2 "INFO: Failed to connect to " host ":" port)
		     (set! *runremote* #f)))))
	    (debug:print 2 "INFO: no server available")))))

Modified tests/tests.scm from [a5186d2c56] to [1e0027e171].

︙
188
189
190
191
192
193
194

195

196
197
198
199

200
201

202
203
204
205
206
207
208

188
189
190
191
192
193
194
195

196
197
198
199

200
201

202
203
204
205
206
207
208
209








+
-
+



-
+

-
+








	(vector-ref (hash-table-ref (db:get-steps-table db test-id) "step1") 4)))

;;======================================================================
;; R E M O T E   C A L L S 
;;======================================================================

;; start a server process
(set! *verbosity* 10)
(define server-pid (process-run "../../bin/megatest" '("-server" "-" "-debug" "10")))
(define server-pid (process-run "../../bin/megatest" (list "-server" "-" "-debug" (conc *verbosity*))))
(sleep 2)
(define start-wait (current-seconds))
(server:client-setup)
;; (set! *verbosity* 10)
(print "Starting intensive cache and rpc test")
(for-each (lambda (params)
	    (rdb:tests-register-test 1 (conc "test" (random 20)) "")
	    ;;; (rdb:tests-register-test #f 1 (conc "test" (random 20)) "")
	    (apply rdb:test-set-status-state test-id params)
	    (rdb:pass-fail-counts test-id (random 100) (random 100))
	    (rdb:test-rollup-iterated-pass-fail test-id)
	    (thread-sleep! 0.01)) ;; cache ordering granularity is at the second level. Should really be at the ms level
	  '(("COMPLETED"    "PASS" #f)
	    ("NOT_STARTED"  "FAIL" "Just testing")
	    ("NOT_STARTED"  "FAIL" "Just testing")
︙

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