Megatest

Diff
Login

Differences From Artifact [14db6902e7]:

To Artifact [db8150709b]:


732
733
734
735
736
737
738

739
740


741
742
743
744
745

746
747
748
749




750
751

752
753
754
755
756
757
758
732
733
734
735
736
737
738
739


740
741
742
743
744
745
746
747




748
749
750
751
752

753
754
755
756
757
758
759
760







+
-
-
+
+





+
-
-
-
-
+
+
+
+

-
+







	  (hash-table-set! *target* run-id thekey)
	  thekey))))

;;======================================================================
;;  T E S T S
;;======================================================================

;; REFACTOR THIS ONE, IT DOESNT FOLLOW CURRENT PATTERNS
(define (db:tests-register-test db run-id test-name item-path)
  (debug:print-info 11 "db:tests-register-test START db=" db ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
(define (db:tests-register-test run-id test-name item-path)
  (debug:print-info 11 "db:tests-register-test START run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
  (let ((item-paths (if (equal? item-path "")
			(list item-path)
			(list item-path ""))))
    (for-each 
     (lambda (pth)
       (cdb:tests-register-test *runremote* run-id test-name pth))
       (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');" 
			run-id 
			test-name
			pth))
       ;; (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');" 
       ;;    run-id 
       ;;    test-name
       ;;    pth))
     item-paths)
  (debug:print-info 11 "db:tests-register-test END db=" db ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
  (debug:print-info 11 "db:tests-register-test END run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
    #f))

;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
;; not-in #t = above behaviour, #f = must match
(define (db:get-tests-for-run db run-id testpatt states statuses 
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316

1317
1318
1319
1320
1321
1322
1323
1308
1309
1310
1311
1312
1313
1314




1315
1316
1317
1318
1319
1320
1321
1322







-
-
-
-
+







(define (cdb:test-rollup-test_data-pass-fail serverdat test-id)
  (cdb:client-call serverdat 'test_data-pf-rollup #t *default-numtries* test-id test-id test-id test-id))

(define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
  (cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))

(define (cdb:tests-register-test serverdat run-id test-name item-path)
  (let ((item-paths (if (equal? item-path "")
			(list item-path)
			(list item-path ""))))
    (cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path)))
  (cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path))

(define (cdb:flush-queue serverdat)
  (cdb:client-call serverdat 'flush #f *default-numtries*))

(define (cdb:kill-server serverdat)
  (cdb:client-call serverdat 'killserver #t *default-numtries*))