Megatest

Check-in [5d93144663]
Login
Overview
Comment:Tweaked some queries to increase the amount of interleaving possible
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5d93144663eaf32a3fed5fcff090e2d44946cf56
User & Date: matt on 2012-02-26 21:35:33
Other Links: manifest | tags
Context
2012-02-26
22:15
Fixed intial values on examine-test for data refresh check-in: 4299ec1adb user: matt tags: trunk
21:35
Tweaked some queries to increase the amount of interleaving possible check-in: 5d93144663 user: matt tags: trunk
19:44
Updated tests to push on simultaneous running check-in: 82c92c7c77 user: matt tags: trunk
Changes

Modified dashboard-tests.scm from [4961c0ebfe] to [2b26f71a92].

266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
266
267
268
269
270
271
272

273
274
275
276
277
278
279
280







-
+







								  "runname") #f))
					;(teststeps     (if testdat (db:get-steps-for-test db test-id) #f))
	       (logfile       "/this/dir/better/not/exist")
	       (rundir        logfile)
	       (testfullname  (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
	       (testname      (if testdat (db:test-get-testname testdat) "n/a"))
	       (testmeta      (if testdat 
				  (let ((tm (rdb:testmeta-get-record db testname)))
				  (let ((tm (db:testmeta-get-record db testname)))
				    (if tm tm (make-db:testmeta)))
				  (make-db:testmeta)))

	       (keystring  (string-intersperse 
			    (map (lambda (keyval)
				   ;; (conc ":" (car keyval) " " (cadr keyval)))
				   (cadr keyval))

Modified db.scm from [c87d22ff44] to [f1afc66bda].

434
435
436
437
438
439
440





441
442








443
444
445
446
447
448
449
434
435
436
437
438
439
440
441
442
443
444
445


446
447
448
449
450
451
452
453
454
455
456
457
458
459
460







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







     run-id
     (if testpatt testpatt "%")
     (if itempatt itempatt "%"))
    res))

;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db run-id test-name itemdat)
  ;; Breaking it into two queries for better file access interleaving
  (let ((ids '()))
    (sqlite3:for-each-row (lambda (id)
			    (set! ids (cons id ids)))
			  db
  (sqlite3:execute db "DELETE FROM test_steps WHERE test_id in (SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?);" 
		   run-id test-name (item-list->path itemdat)))
			  "SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
			  run-id test-name (item-list->path itemdat))
    (for-each (lambda (id)
		(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" id)
		(thread-sleep! 0.1)) ;; give others access to the db
	      ids)))
;;"DELETE FROM test_steps WHERE test_id in (SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?);" 
		   
;; 
(define (db:delete-test-records db test-id)
  (sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
  (sqlite3:execute db "DELETE FROM test_data  WHERE test_id=?;" test-id)
  (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id))

;; set tests with state currstate and status currstatus to newstate and newstatus
625
626
627
628
629
630
631
632

633
634
635
636
637
638
639
636
637
638
639
640
641
642

643
644
645
646
647
648
649
650







-
+








;;======================================================================
;; QUEUE UP META, TEST STATUS AND STEPS
;;======================================================================

(define (db:updater db)
  (let loop ((start-time (current-time)))
    (thread-sleep! (+ 2 (random 10))) ;; move save time around to minimize regular collisions
    (thread-sleep! 0.5) ;; move save time around to minimize regular collisions?
    (db:write-cached-data db)
    (loop start-time)))
    
(define (db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree)
  (if (not item-path)
      (begin (debug:print 0 "WARNING: ITEMPATH not set.")   
	     (set! item-path "")))
980
981
982
983
984
985
986

987
988
989
990
991
992
993
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005







+







	  (mutex-lock! *incoming-mutex*)
	  (set! *incoming-data* (cons (vector 'step-status
					      (current-seconds)
					      ;; FIXME - this should not update the logfile unless it is specified.
					      (list test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile "")))
				      *incoming-data*))
	  (mutex-unlock! *incoming-mutex*)
	  (if (not *cache-on*)(db:write-cached-data db))
	  #t)
	(debug:print 0 "ERROR: Can't update " test-name " for run " run-id " -> no such test in db"))))

;;======================================================================
;; Extract ods file from the db
;;======================================================================

Modified launch.scm from [0201b79908] to [fc84969590].

90
91
92
93
94
95
96

97
98
99
100
101
102
103
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104







+







	      (begin
		(debug:print 0 "Failed to setup, exiting") 
		(exit 1)))
	  ;; now can find our db
	  (set! db (open-db))
	  (if (not (args:get-arg "-server"))
	      (server:client-setup db))
	  (set! *cache-on* #t)
	  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
	  (change-directory work-area) 
	  (set-run-config-vars db run-id)
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
	  (set-megatest-env-vars db run-id)
	  (set-item-env-vars itemdat)

Modified runs.scm from [f4fc1b00d9] to [7215eb8cc1].

614
615
616
617
618
619
620
621

622
623
624
625

626
627
628
629
630
631
632
614
615
616
617
618
619
620

621
622
623
624

625
626
627
628
629
630
631
632







-
+



-
+








;;======================================================================
;; Rollup runs
;;======================================================================

;; Update the test_meta table for this test
(define (runs:update-test_meta db test-name test-conf)
  (let ((currrecord (rdb:testmeta-get-record db test-name)))
  (let ((currrecord (db:testmeta-get-record db test-name)))
    (if (not currrecord)
	(begin
	  (set! currrecord (make-vector 10 #f))
	  (rdb:testmeta-add-record db test-name)))
	  (db:testmeta-add-record db test-name)))
    (for-each 
     (lambda (key)
       (let* ((idx (cadr key))
	      (fld (car  key))
	      (val (config-lookup test-conf "test_meta" fld)))
	 ;; (debug:print 5 "idx: " idx " fld: " fld " val: " val)
	 (if (and val (not (equal? (vector-ref currrecord idx) val)))