Megatest

Check-in [ab830bcc7c]
Login
Overview
Comment:Fixed bug
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | fixup
Files: files | file ages | folders
SHA1: ab830bcc7cb0dafba059935d13ae3b39e3de27a5
User & Date: mrwellan on 2011-09-28 10:10:06
Other Links: branch diff | manifest | tags
Context
2011-09-28
11:18
Fixed sorting on buttons in dashboard check-in: d4ffcebff2 user: mrwellan tags: fixup (unpublished)
10:10
Fixed bug check-in: ab830bcc7c user: mrwellan tags: fixup (unpublished)
2011-09-26
11:22
Fixed up Makefile to install mt_ files in PREFIX check-in: f2ad9ca9c4 user: mrwellan tags: fixup (unpublished)
Changes

Modified db.scm from [a44087c573] to [18c6d5d535].

350
351
352
353
354
355
356
357
358


359
360
361
362
363
364
365


366

367
368
369
370
371
372
373
350
351
352
353
354
355
356


357
358


359
360
361
362
363
364
365

366
367
368
369
370
371
372
373







-
-
+
+
-
-





+
+
-
+







(define-inline (db:test-get-first_err    vec) (printable (vector-ref vec 15))) ;; 19)))
(define-inline (db:test-get-first_warn   vec) (printable (vector-ref vec 16))) ;; 20)))

(define-inline (db:test-set-testname! vec val)(vector-set! vec 2 val))
(define-inline (db:test-set-state!    vec val)(vector-set! vec 3 val))
(define-inline (db:test-set-status!   vec val)(vector-set! vec 4 val))

(define (db-get-tests-for-run db run-id . params)
  (let ((res '())
(define (db-get-tests-for-run db run-id testpatt itempatt)
  (let ((res '()))
	(testpatt (if (or (null? params)(not (car params))) "%" (car params)))
	(itempatt (if (> (length params) 1)(cadr params) "%")))
    (sqlite3:for-each-row 
     (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment first-err first-warn)
       (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment first-err first-warn) res)))
     db 
     "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,first_err,first_warn FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? ORDER BY id DESC;"
     run-id
     (if testpatt testpatt "%")
     run-id testpatt (if itempatt itempatt "%"))
     (if itempatt itempatt "%"))
    res))

;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db run-id test-name itemdat)
  (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)))
;; 
724
725
726
727
728
729
730
731

732
733
734
735
736
737
738
724
725
726
727
728
729
730

731
732
733
734
735
736
737
738







-
+







;;
;; Return a list of prereqs that were NOT met
;;  Tests (and all items) in waiton list must be "COMPLETED" and "PASS"
(define (db-get-prereqs-not-met db run-id waiton)
  (if (null? waiton)
      '()
      (let* ((unmet-pre-reqs '())
	     (tests           (db-get-tests-for-run db run-id))
	     (tests           (db-get-tests-for-run db run-id #f #f))
	     (result         '()))
	(for-each (lambda (waitontest-name)
		    (let ((ever-seen #f))
		      (for-each (lambda (test)
				  (if (equal? waitontest-name (db:test-get-testname test))
				      (begin
					(set! ever-seen #t)

Modified megatest.scm from [5cbadc7e03] to [2e3a20ccc5].

386
387
388
389
390
391
392
393

394
395
396
397
398
399
400
386
387
388
389
390
391
392

393
394
395
396
397
398
399
400







-
+







	    (debug:print 2 "Exectuing " test-name " on " (get-host-name))
	    (change-directory testpath)
	    (setenv "MT_TEST_RUN_DIR" work-area)
	    (setenv "MT_TEST_NAME" test-name)
	    (setenv "MT_ITEM_INFO" (conc itemdat))
	    (setenv "MT_RUNNAME"   runname)
	    (setenv "MT_MEGATEST"  megatest)
	    (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path))
	    (if mt-bindir-path (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path)))
	    
	    (if (not (setup-for-run))
		(begin
		  (debug:print 0 "Failed to setup, exiting") 
		  (exit 1)))
	    ;; now can find our db
	    (set! db (open-db))

Modified runs.scm from [10c3a07445] to [ba29b0b8e2].

117
118
119
120
121
122
123

124

125
126
127
128
129
130
131
117
118
119
120
121
122
123
124

125
126
127
128
129
130
131
132







+
-
+







	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db-get-tests-for-run db hed test-name item-path)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      (if (null? results) #f
		      (car results)))))))))
			  (car results))))))))))
    
;; get the previous records for when these tests were run where all keys match but runname
;; NB// Merge this with test:get-previous-test-run-records? This one looks for all matching tests
;; can use wildcards. 
(define (test:get-matching-previous-test-run-records db run-id test-name item-path)
  (let* ((keys    (db:get-keys db))
	 (selstr  (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))