Megatest

Diff
Login

Differences From Artifact [378f0551a1]:

To Artifact [8b953ea457]:


1100
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
1100
1101
1102
1103
1104
1105
1106

1107
1108
1109
1110
1111
1112
1113
1114







-
+







				      (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 db run-id test-name item-path #!key (force-write #f))
(define (cdb:tests-register-test 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
1692
1693
1694
1695
1696
1697
1698
1699

1700
1701
1702
1703
1704


1705
1706
1707
1708
1709
1710
1711
1712
1692
1693
1694
1695
1696
1697
1698

1699
1700
1701
1702


1703
1704
1705
1706
1707
1708
1709
1710
1711
1712







-
+



-
-
+
+








  (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 db run-id test-name item-path)
(define (rdb:tests-register-test 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) db run-id test-name item-path force-write: #t))
      (cdb:tests-register-test db run-id test-name item-path force-write: #t)))
	((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)))

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