Megatest

Check-in [db3b39bb04]
Login
Overview
Comment:Incrementing towards the threaded test registration code. tests-register-tests converted to cdb:tests-register-test
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.54
Files: files | file ages | folders
SHA1: db3b39bb045419be64b7f7a54cd2afc101bffdaf
User & Date: matt on 2013-04-27 16:59:02
Other Links: branch diff | manifest | tags
Context
2013-04-27
18:31
Converted remaining tests-register-test call into agregregated call check-in: bedfe9de61 user: matt tags: v1.54
16:59
Incrementing towards the threaded test registration code. tests-register-tests converted to cdb:tests-register-test check-in: db3b39bb04 user: matt tags: v1.54
16:52
Converted some open-run-close calls to cdb:remote-run check-in: 13cd0c805d user: matt tags: v1.54
Changes

Modified db.scm from [14db6902e7] to [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*))