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 '())
(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 testpatt (if itempatt itempatt "%"))
|
|
|
<
<
>
>
|
|
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 testpatt itempatt)
(let ((res '()))
(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 "%")
(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
|
(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)
(let ((max-val (+ expected tol))
(min-val (- expected tol)))
(set! status (if (and (>= value min-val)(<= value max-val)) "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))))))
(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 '()))
|
|
>
|
>
>
>
|
|
|
>
>
>
>
|
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 "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))
(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
|
;;
;; 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))
(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)
|
|
|
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 #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)
|