Megatest

Check-in [6bee52c53c]
Login
Overview
Comment:rpc stuff all working now
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | servermode
Files: files | file ages | folders
SHA1: 6bee52c53c0f9312107ed81e0ec5d8567cf81765
User & Date: matt on 2012-03-12 09:01:38
Other Links: branch diff | manifest | tags
Context
2012-03-13
06:59
Merged servermode to trunk check-in: 3e2cee87de user: matt tags: trunk
2012-03-12
15:29
Bumping version and added missing definition for rdb:test-get-path Closed-Leaf check-in: 7da47085ea user: mrwellan tags: servermode
09:01
rpc stuff all working now check-in: 6bee52c53c user: matt tags: servermode
2012-03-11
23:26
tweaked check-in: a680aa27b4 user: matt tags: servermode
Changes

Modified megatest.scm from [99a2f28f17] to [58ffc597e0].

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







+








(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses tests))

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

624
625
626
627
628
629
630
631

632
633

634
635
636
637
638
639
640
625
626
627
628
629
630
631

632
633

634
635
636
637
638
639
640
641







-
+

-
+







	  (set! db (open-db))
	  (if (not (args:get-arg "-server"))
	      (server:client-setup db))
	  (if (args:get-arg "-load-test-data")
	      ;; has sub commands that are rdb:
	      (db:load-test-data db test-id))
	  (if (args:get-arg "-setlog")
	      (rdb:test-set-log! db test-id (args:get-arg "-setlog")))
	      (rtests:test-set-log! db test-id (args:get-arg "-setlog")))
	  (if (args:get-arg "-set-toplog")
	      (rdb:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
	      (rtests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
	  (if (args:get-arg "-summarize-items")
	      (rdb:tests:summarize-items db run-id test-name #t)) ;; do force here
	  (if (args:get-arg "-runstep")
	      (if (null? remargs)
		  (begin
		    (debug:print 0 "ERROR: nothing specified to run!")
		    (sqlite3:finalize! db)

Modified server.scm from [adec0ec192] to [0c84f97116].

235
236
237
238
239
240
241






242
243
244
245
246
247
248
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254







+
+
+
+
+
+







    
    (rpc:publish-procedure!
     'rtests:test-set-status!
     (lambda (test-id state status comment dat)
       (set! *last-db-access* (current-seconds))
       (test-set-status! db test-id state status comment dat)))

    (rpc:publish-procedure!
     'rtests:test-set-toplog!
     (lambda (run-id test-name logf)
        (set! *last-db-access* (current-seconds))
        (test-set-toplog! db run-id test-name logf)))

    ;;======================================================================
    ;; end of publish-procedure section
    ;;======================================================================

    (set! *rpc:listener* rpc:listener)
    (on-exit (lambda ()
	       (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' and val=?;" host:port)

Modified tests.scm from [0902ef46a0] to [18d52e02c6].

391
392
393
394
395
396
397









391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406







+
+
+
+
+
+
+
+
+

(define (rtests:test-set-status!  db test-id state status comment dat)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rtests:test-set-status! host port) test-id state status comment dat))
      (test-set-status! db test-id state status comment dat)))

(define (rtests:test-set-toplog! db run-id test-name logf)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
            (port (vector-ref *runremote* 1)))
        ((rpc:procedure 'rtests:test-set-toplog! host port) run-id test-name logf))
      (test-set-toplog! db run-id test-name logf)))