Megatest

Diff
Login

Differences From Artifact [a453d29161]:

To Artifact [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)))