Megatest

Check-in [197b642483]
Login
Overview
Comment:Backed out rpc of register-test, test1,test4 working
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | test-specific-db
Files: files | file ages | folders
SHA1: 197b642483e482ee6fe1061ca5dbe02265f559c6
User & Date: mrwellan on 2012-10-05 17:04:19
Other Links: branch diff | manifest | tags
Context
2012-10-06
14:25
Reverted register-test to not be remote in test1 check-in: fb07933d2a user: matt tags: test-specific-db
2012-10-05
17:04
Backed out rpc of register-test, test1,test4 working check-in: 197b642483 user: mrwellan tags: test-specific-db
16:38
Changed register-test to do a flush immediately check-in: 706a4ef570 user: mrwellan tags: test-specific-db
Changes

Modified db.scm from [d1723d75e5] to [a453d29161].

599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618













619
620
621
622
623
624
625
599
600
601
602
603
604
605













606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625







-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







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

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

;; (define (db:tests-register-test db run-id test-name item-path)
;;   (debug:print 4 "INFO: db:tests-register-test db=" db ", 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)
;;        (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)
;;     #f))
(define (db:tests-register-test db run-id test-name item-path)
  (debug:print 4 "INFO: db:tests-register-test db=" db ", 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)
       (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)
    #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 itempatt states statuses 

Modified runs.scm from [2817b1bec2] to [260a499583].

400
401
402
403
404
405
406
407

408
409
410
411
412
413
414
400
401
402
403
404
405
406

407
408
409
410
411
412
413
414







-
+







		  ;; else the run is stuck, temporarily or permanently
		  ;; but should check if it is due to lack of resources vs. prerequisites
		  (debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts)
		  (thread-sleep! *global-delta*)
		  (if (not (null? tal))
		      (loop (car tal)(cdr tal) reruns)))
		 ((not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
		  (rdb:tests-register-test run-id test-name item-path)
		  (open-run-close db:tests-register-test #f run-id test-name item-path)
		  (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) #t)
		  (thread-sleep! *global-delta*)
		  (loop (car newtal)(cdr newtal) reruns))
		 ((not have-resources) ;; simply try again after waiting a second
		  (thread-sleep! (+ 1 *global-delta*))
		  (debug:print 1 "INFO: no resources to run new tests, waiting ...")
		  ;; could have done hed tal here but doing car/cdr of newtal to rotate tests
612
613
614
615
616
617
618
619

620
621
622
623
624
625
626
612
613
614
615
616
617
618

619
620
621
622
623
624
625
626







-
+







	    ;;
	    ;; NB// for the above line. I want the test to be registered long before this routine gets called!
	    ;;
	    (set! test-id (open-run-close db:get-test-id db run-id test-name item-path))
	    (if (not test-id)
		(begin
		  (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id)
		  (rdb:tests-register-test run-id test-name item-path)
		  (open-run-close db:tests-register-test #f run-id test-name item-path)
		  (set! test-id (open-run-close db:get-test-id db run-id test-name item-path))))
	    (debug:print 4 "INFO: test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
	    (set! testdat (open-run-close db:get-test-info-by-id db test-id))))
      (set! test-id (db:test-get-id testdat))
      (change-directory test-path)
      (case (if force ;; (args:get-arg "-force")
		'NOT_STARTED