Megatest

Diff
Login

Differences From Artifact [4f7891c314]:

To Artifact [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)))
;; 
530
531
532
533
534
535
536
537
538



539
540
541
542
543
544
545



546
547
548
549
550
551





552
553
554
555
556
557
558


559
560
561
562
563
564
565
530
531
532
533
534
535
536


537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552



553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573







-
-
+
+
+







+
+
+



-
-
-
+
+
+
+
+







+
+







	      (comment     (list-ref padded-row 6))
	      (status      (let ((s (list-ref padded-row 7)))
			     (if (and (string? s)(or (string-match (regexp "^\\s*$") s)
						     (string-match (regexp "^n/a$") s)))
				 #f
				 s)))) ;; if specified on the input then use, else calculate
	 ;; look up expected,tol,units from previous best fit test if they are all either #f or ''
	 (debug:print 4 "category: " category ", variable: " variable ", value: " value 
		      ", expected: " expected ", tol: " tol ", units: " units ", status: " status ", comment: " comment)
	 (debug:print 4 "BEFORE: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)

	 (if (and (or (not expected)(equal? expected ""))
		  (or (not tol)     (equal? expected ""))
		  (or (not units)   (equal? expected "")))
	     (let-values (((new-expected new-tol new-units)(db:get-prev-tol-for-test db test-id category variable)))
	       (set! expected new-expected)
	       (set! tol      new-tol)
	       (set! units    new-units)))

	 (debug:print 4 "AFTER:  category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 ;; calculate status if NOT specified
	 (if (and (not status)(number? expected)(number? value)) ;; need expected and value to be numbers
	     (if (number? tol) ;; if tol is a number then we do the standard comparison
		 (let ((max-val (+ expected tol))
		       (min-val (- expected tol)))
		   (set! status (if (and (>=  value min-val)(<= value max-val)) "pass" "fail")))
		 (let* ((max-val (+ expected tol))
			(min-val (- expected tol))
			(result  (and (>=  value min-val)(<= value max-val))))
		   (debug:print 4 "max-val: " max-val " min-val: " min-val " result: " result)
		   (set! status (if result "pass" "fail")))
		 (set! status ;; NB// need to assess each one (i.e. not return operator since need to act if not valid op.
		       (case (string->symbol tol) ;; tol should be >, <, >=, <=
			 ((>)  (if (>  value expected) "pass" "fail"))
			 ((<)  (if (<  value expected) "pass" "fail"))
			 ((>=) (if (>= value expected) "pass" "fail"))
			 ((<=) (if (<= value expected) "pass" "fail"))
			 (else (conc "ERROR: bad tol comparator " tol))))))
	 (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status) VALUES (?,?,?,?,?,?,?,?,?);"
	      test-id category variable value expected tol units (if comment comment "") status)))
     csvlist)))

;; get a list of test_data records matching categorypatt
(define (db:read-test-data db test-id categorypatt)
  (let ((res '()))
716
717
718
719
720
721
722
723

724
725
726
727
728
729
730
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)