Megatest

Diff
Login

Differences From Artifact [6268431c21]:

To Artifact [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