Megatest

Check-in [c48bc5a711]
Login
Overview
Comment:Merged back in changes for test_data type handling
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c48bc5a711b6595f30439819375c99f35af74b73
User & Date: matt on 2011-12-04 23:25:13
Other Links: manifest | tags
Context
2011-12-05
10:13
Added MT_RUNNAME back in check-in: 38766f7852 user: mrwellan tags: trunk
2011-12-04
23:25
Merged back in changes for test_data type handling check-in: c48bc5a711 user: matt tags: trunk
21:56
Added test for logpro required regression and some tweaks to dashboard look 'n feel check-in: 3c70848db0 user: matt tags: trunk
Changes

Modified dashboard-tests.scm from [e8ada23103] to [2959a1c9ce].

429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450

451
452
453
454
455
456
457
				      #:expand "YES"
				      #:multiline "YES"
				      #:font "Courier New, -10"
				      #:size "100x100")))
		   (hash-table-set! widgets "Test Data"
				    (lambda (testdat) ;; 
				      (let* ((currval (iup:attribute test-data "VALUE")) ;; "TITLE"))
					     (fmtstr  "~10a~10a~10a~10a~7a~7a~6a~a") ;; category,variable,value,expected,tol,units,comment
					     (newval  (string-intersperse 
						       (append
							(list 
							 (format #f fmtstr "Category" "Variable" "Value" "Expected" "Tol" "Status" "Units" "Comment")
							 (format #f fmtstr "========" "========" "=====" "========" "===" "======" "=====" "======="))
							(map (lambda (x)
							       (format #f fmtstr
								       (db:test-data-get-category x)
								       (db:test-data-get-variable x)
								       (db:test-data-get-value    x)
								       (db:test-data-get-expected x)
								       (db:test-data-get-tol      x)
								       (db:test-data-get-status   x)
								       (db:test-data-get-units    x)

								       (db:test-data-get-comment  x)))
							     (db:read-test-data db test-id "%")))
						       "\n")))
					(if (not (equal? currval newval))
					    (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
		   test-data)))
		)))







|



|
|









>







429
430
431
432
433
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
				      #:expand "YES"
				      #:multiline "YES"
				      #:font "Courier New, -10"
				      #:size "100x100")))
		   (hash-table-set! widgets "Test Data"
				    (lambda (testdat) ;; 
				      (let* ((currval (iup:attribute test-data "VALUE")) ;; "TITLE"))
					     (fmtstr  "~10a~10a~10a~10a~7a~7a~6a~6a~a") ;; category,variable,value,expected,tol,units,type,comment
					     (newval  (string-intersperse 
						       (append
							(list 
							 (format #f fmtstr "Category" "Variable" "Value" "Expected" "Tol" "Status" "Units" "Type" "Comment")
							 (format #f fmtstr "========" "========" "=====" "========" "===" "======" "=====" "====" "======="))
							(map (lambda (x)
							       (format #f fmtstr
								       (db:test-data-get-category x)
								       (db:test-data-get-variable x)
								       (db:test-data-get-value    x)
								       (db:test-data-get-expected x)
								       (db:test-data-get-tol      x)
								       (db:test-data-get-status   x)
								       (db:test-data-get-units    x)
								       (db:test-data-get-type     x)
								       (db:test-data-get-comment  x)))
							     (db:read-test-data db test-id "%")))
						       "\n")))
					(if (not (equal? currval newval))
					    (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
		   test-data)))
		)))

Modified db.scm from [6268431c21] to [0f8943e29c].

513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

533
534
535
536
537
538
539
540
541
542
  (debug:print 4 "test-id " test-id ", csvdata: " csvdata)
  (let ((csvlist (csv->list (make-csv-reader
			     (open-input-string csvdata)
			     '((strip-leading-whitespace? #t)
			       (strip-trailing-whitespace? #t)) )))) ;; (csv->list csvdata)))
    (for-each 
     (lambda (csvrow)
       (let* ((padded-row  (take (append csvrow (list #f #f #f #f #f #f #f #f)) 8))
	      (category    (list-ref padded-row 0))
	      (variable    (list-ref padded-row 1))
	      (value       (any->number-if-possible (list-ref padded-row 2)))
	      (expected    (any->number-if-possible (list-ref padded-row 3)))
	      (tol         (any->number-if-possible (list-ref padded-row 4))) ;; >, <, >=, <=, or a number
	      (units       (list-ref padded-row 5))
	      (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)







|











|
>


|







513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
  (debug:print 4 "test-id " test-id ", csvdata: " csvdata)
  (let ((csvlist (csv->list (make-csv-reader
			     (open-input-string csvdata)
			     '((strip-leading-whitespace? #t)
			       (strip-trailing-whitespace? #t)) )))) ;; (csv->list csvdata)))
    (for-each 
     (lambda (csvrow)
       (let* ((padded-row  (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9))
	      (category    (list-ref padded-row 0))
	      (variable    (list-ref padded-row 1))
	      (value       (any->number-if-possible (list-ref padded-row 2)))
	      (expected    (any->number-if-possible (list-ref padded-row 3)))
	      (tol         (any->number-if-possible (list-ref padded-row 4))) ;; >, <, >=, <=, or a number
	      (units       (list-ref padded-row 5))
	      (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
	      (type        (list-ref padded-row 8)))
	 ;; 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 " type: " type)

	 (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)
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591

592
593
594
595
596
597
598
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
			 ((>)  (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 '()))
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status)
       (set! res (cons (vector id test_id category variable value expected tol units comment status) res)))
     db
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
    (reverse res)))

(define (db:load-test-data db run-id test-name itemdat)
  (let* ((item-path (item-list->path itemdat))
	 (testdat (db:get-test-info db run-id test-name item-path))
	 (test-id (if testdat (db:test-get-id testdat) #f)))
    ;; (debug:print 1 "Enter records to insert in the test_data table, seven fields, comma separated per line")
    (debug:print 4 "itemdat: " itemdat ", test-name: " test-name ", test-id: " test-id)
    (if test-id
	(let loop ((lin (read-line)))
	  (if (not (eof-object? lin))
	      (begin
		(debug:print 4 lin)
		(db:csv->test-data db test-id lin)
		(loop (read-line))))))
    ;; roll up the current results.

    (db:test-data-rollup db test-id)))

;; WARNING: Do NOT call this for the parent test on an iterated test
;; Roll up test_data pass/fail results
;; look at the test_data status field, 
;;    if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS.
;;    if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored
(define (db:test-data-rollup db test-id)
  (sqlite3:execute 
   db 
   "UPDATE tests 
      SET fail_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail'),
          pass_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass')
      WHERE id=?;"
   test-id test-id test-id)
  ;; if the test is not FAIL then set status based on the fail and pass counts.
  (thread-sleep! 1)
  (sqlite3:execute
   db
   "UPDATE tests
      SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 
                         THEN 'FAIL'
                      WHEN (SELECT pass_count FROM tests WHERE id=?) > 0

                         THEN 'PASS'
                      ELSE status
                  END WHERE id=?;"
   test-id test-id test-id))

(define (db:get-prev-tol-for-test db test-id category variable)
  ;; Finish me?
  (values #f #f #f))

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







|
|






|
|

|
















>
|






|










|



|
>



|







558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
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
626
627
628
			 ((>)  (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,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
			  test-id category variable value expected tol units (if comment comment "") status type)))
     csvlist)))

;; get a list of test_data records matching categorypatt
(define (db:read-test-data db test-id categorypatt)
  (let ((res '()))
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status type)
       (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
     db
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
    (reverse res)))

(define (db:load-test-data db run-id test-name itemdat)
  (let* ((item-path (item-list->path itemdat))
	 (testdat (db:get-test-info db run-id test-name item-path))
	 (test-id (if testdat (db:test-get-id testdat) #f)))
    ;; (debug:print 1 "Enter records to insert in the test_data table, seven fields, comma separated per line")
    (debug:print 4 "itemdat: " itemdat ", test-name: " test-name ", test-id: " test-id)
    (if test-id
	(let loop ((lin (read-line)))
	  (if (not (eof-object? lin))
	      (begin
		(debug:print 4 lin)
		(db:csv->test-data db test-id lin)
		(loop (read-line))))))
    ;; roll up the current results.
    ;; FIXME: Add the status to 
    (db:test-data-rollup db test-id #f)))

;; WARNING: Do NOT call this for the parent test on an iterated test
;; Roll up test_data pass/fail results
;; look at the test_data status field, 
;;    if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS.
;;    if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored
(define (db:test-data-rollup db test-id status)
  (sqlite3:execute 
   db 
   "UPDATE tests 
      SET fail_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail'),
          pass_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass')
      WHERE id=?;"
   test-id test-id test-id)
  ;; if the test is not FAIL then set status based on the fail and pass counts.
  (thread-sleep! 1)
  (sqlite3:execute
   db   ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME
   "UPDATE tests
      SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 
                         THEN 'FAIL'
                      WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND 
                           (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL')
                         THEN 'PASS'
                      ELSE status
                  END WHERE id=?;"
   test-id test-id test-id test-id))

(define (db:get-prev-tol-for-test db test-id category variable)
  ;; Finish me?
  (values #f #f #f))

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

Modified db_records.scm from [e1374dd7ef] to [c935a2b5a6].

63
64
65
66
67
68
69

70
71
72
73
74
75
76
(define-inline (db:test-data-get-variable         vec)    (vector-ref  vec 3))
(define-inline (db:test-data-get-value            vec)    (vector-ref  vec 4))
(define-inline (db:test-data-get-expected         vec)    (vector-ref  vec 5))
(define-inline (db:test-data-get-tol              vec)    (vector-ref  vec 6))
(define-inline (db:test-data-get-units            vec)    (vector-ref  vec 7))
(define-inline (db:test-data-get-comment          vec)    (vector-ref  vec 8))
(define-inline (db:test-data-get-status           vec)    (vector-ref  vec 9))


;;======================================================================
;; S T E P S 
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time    
(define (make-db:step)(make-vector 7))







>







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
(define-inline (db:test-data-get-variable         vec)    (vector-ref  vec 3))
(define-inline (db:test-data-get-value            vec)    (vector-ref  vec 4))
(define-inline (db:test-data-get-expected         vec)    (vector-ref  vec 5))
(define-inline (db:test-data-get-tol              vec)    (vector-ref  vec 6))
(define-inline (db:test-data-get-units            vec)    (vector-ref  vec 7))
(define-inline (db:test-data-get-comment          vec)    (vector-ref  vec 8))
(define-inline (db:test-data-get-status           vec)    (vector-ref  vec 9))
(define-inline (db:test-data-get-type             vec)    (vector-ref  vec 10))

;;======================================================================
;; S T E P S 
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time    
(define (make-db:step)(make-vector 7))

Modified tests.scm from [42fb9b9880] to [23617ff8a1].

138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172
173
174
175
176
177

178
179
180
181
182
183
184
    ;; update the primary record IF state AND status are defined
    (if (and state status)
	(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" 
			 state real-status run-id test-name item-path))

    ;; if status is "AUTO" then call rollup
    (if (and test-id state status (equal? status "AUTO")) 
	(db:test-data-rollup db test-id))

    ;; add metadata (need to do this way to avoid SQL injection issues)

    ;; :first_err
    ;; (let ((val (hash-table-ref/default otherdat ":first_err" #f)))
    ;;   (if val
    ;;       (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; 
    ;; ;; :first_warn
    ;; (let ((val (hash-table-ref/default otherdat ":first_warn" #f)))
    ;;   (if val
    ;;       (sqlite3:execute db "UPDATE tests SET first_warn=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))

    (let ((category (hash-table-ref/default otherdat ":category" ""))
	  (variable (hash-table-ref/default otherdat ":variable" ""))
	  (value    (hash-table-ref/default otherdat ":value"    #f))
	  (expected (hash-table-ref/default otherdat ":expected" #f))
	  (tol      (hash-table-ref/default otherdat ":tol"      #f))
	  (units    (hash-table-ref/default otherdat ":units"    ""))

	  (dcomment (hash-table-ref/default otherdat ":comment"  "")))
      (debug:print 4 
		   "category: " category ", variable: " variable ", value: " value
		   ", expected: " expected ", tol: " tol ", units: " units)
      (if (and value expected tol) ;; all three required
	  (db:csv->test-data db test-id 
			     (conc category ","
				   variable ","
				   value    ","
				   expected ","
				   tol      ","
				   units    ","
				   dcomment ","))))

				   
    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (and (not (equal? item-path ""))
	     (or (equal? status "PASS")
		 (equal? status "WARN")
		 (equal? status "FAIL")
		 (equal? status "WAIVED")







|



















>












|
>







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
    ;; update the primary record IF state AND status are defined
    (if (and state status)
	(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" 
			 state real-status run-id test-name item-path))

    ;; if status is "AUTO" then call rollup
    (if (and test-id state status (equal? status "AUTO")) 
	(db:test-data-rollup db test-id status))

    ;; add metadata (need to do this way to avoid SQL injection issues)

    ;; :first_err
    ;; (let ((val (hash-table-ref/default otherdat ":first_err" #f)))
    ;;   (if val
    ;;       (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; 
    ;; ;; :first_warn
    ;; (let ((val (hash-table-ref/default otherdat ":first_warn" #f)))
    ;;   (if val
    ;;       (sqlite3:execute db "UPDATE tests SET first_warn=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))

    (let ((category (hash-table-ref/default otherdat ":category" ""))
	  (variable (hash-table-ref/default otherdat ":variable" ""))
	  (value    (hash-table-ref/default otherdat ":value"    #f))
	  (expected (hash-table-ref/default otherdat ":expected" #f))
	  (tol      (hash-table-ref/default otherdat ":tol"      #f))
	  (units    (hash-table-ref/default otherdat ":units"    ""))
	  (type     (hash-table-ref/default otherdat ":type"     ""))
	  (dcomment (hash-table-ref/default otherdat ":comment"  "")))
      (debug:print 4 
		   "category: " category ", variable: " variable ", value: " value
		   ", expected: " expected ", tol: " tol ", units: " units)
      (if (and value expected tol) ;; all three required
	  (db:csv->test-data db test-id 
			     (conc category ","
				   variable ","
				   value    ","
				   expected ","
				   tol      ","
				   units    ","
				   dcomment ",," ;; extra comma for status
				   type     ))))
				   
    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (and (not (equal? item-path ""))
	     (or (equal? status "PASS")
		 (equal? status "WARN")
		 (equal? status "FAIL")
		 (equal? status "WAIVED")

Modified tests/tests/runfirst/main.sh from [e1e013c667] to [dcbeab62ba].

14
15
16
17
18
19
20





21
22
23
24
foo,bla,1.2,1.9,<
foo,bal,1.2,1.2,<,,Check for overload
foo,alb,1.2,1.2,<=,Amps,This is the high power circuit test
foo,abl,1.2,1.3,0.1
foo,bra,1.2,pass,silly stuff
faz,bar,10,8mA,,,"this is a comment"
EOF






$MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" :value 10e6 :expected_value 1.1e6 :tol 100e3 :category nada :variable sillyvar :units mFarks :comment "This is the value/expected comment"

# $MT_MEGATEST -test-status :state COMPLETED :status FAIL







>
>
>
>
>




14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
foo,bla,1.2,1.9,<
foo,bal,1.2,1.2,<,,Check for overload
foo,alb,1.2,1.2,<=,Amps,This is the high power circuit test
foo,abl,1.2,1.3,0.1
foo,bra,1.2,pass,silly stuff
faz,bar,10,8mA,,,"this is a comment"
EOF

$MT_MEGATEST -load-test-data << EOF
cat,  var, val, exp, comp, units, comment, status, type
ameas,iout,1.2,1.9,>,Amps,Comment,,meas
EOF

$MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" :value 10e6 :expected_value 1.1e6 :tol 100e3 :category nada :variable sillyvar :units mFarks :comment "This is the value/expected comment"

# $MT_MEGATEST -test-status :state COMPLETED :status FAIL