Megatest

;; convert stuff to a number if possible
(define (any->number val)
  (cond 
   ((number? val) val)
   ((string? val) (string->number val))
   ((symbol? val) (any->number (symbol->string val)))
   (else #f)))

(define (any->number-if-possible val)
  (let ((num (any->number val)))
    (if num num val)))

;;======================================================================
;; System stuff
;;======================================================================

(define (get-df path)
  (let* ((df-results (cmd-run->list (conc "df " path)))

                                category TEXT DEFAULT '',
                                variable TEXT,
	                        value REAL,
	                        expected_value REAL,
	                        tol REAL,
                                units TEXT,
                                comment TEXT DEFAULT '',
                                status TEXT DEFAULT 'n/a',
                              CONSTRAINT test_data UNIQUE (test_id,category,variable));")))
     (if (< mver megatest-version)
	 (db:set-var db "MEGATEST_VERSION" megatest-version)))))

;;======================================================================
;; meta get and set vars
;;======================================================================

;; update one of the testmeta fields
(define (db:testmeta-update-field db testname field value)
  (sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname))

;;======================================================================
;; T E S T   D A T A 
;;======================================================================
(define (make-db:test-data)(make-vector 10))
(define-inline (db:test-data-get-id               vec)    (vector-ref  vec 0))
(define-inline (db:test-data-get-test_id          vec)    (vector-ref  vec 1))
(define-inline (db:test-data-get-category         vec)    (vector-ref  vec 2))
(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_value   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 (db:csv->testdata db test-id csvdata)
  (let ((csvlist (csv->list csvdata)))
(define (db:csv->test-data db test-id 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 '(#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      (list-ref padded-row 7))) ;; 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 ''
	 (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)))
	 ;; 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")))
		 (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))))))
       (apply sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment) VALUES (?,?,?,?,?,?,?);"
	      test-id (take (append csvrow '("" "" "" "" "" "" "")) 7)))
	 (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected_value,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_value tol units comment status)
       (set! res (cons res (vector id test_id category variable value expected_value tol units comment status))))
     db
     "SELECT id,test_id,category,variable,value,expected_value,tol,units,comment,status FROM test_data WHERE test_id=? AND category LIKE ?;" 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 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->testdata db test-id lin)
		(loop (read-line)))))))    )
		(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.
  (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 
;;======================================================================
;; 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 6))

	      (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
					  (endt   (any->number (vector-ref record 2))))
				      (debug:print 4 "record[1]=" (vector-ref record 1) 
						   ", startt=" startt ", endt=" endt
						   ", get-status: " (db:step-get-status step))
				      (if (and (number? startt)(number? endt))
					  (seconds->hr-min-sec (- endt startt)) "-1"))))
	     (else   (vector-set! record 1 (db:step-get-event_time step)))
	     (vector-set! record 2 (db:step-get-state step))
	     (vector-set! record 3 (db:step-get-status step))
	     (vector-set! record 4 (db:step-get-event_time step)))
	     (else   (vector-set! record 1 (db:step-get-event_time step))))
	   (vector-set! record 2 (db:step-get-state step))
	   (vector-set! record 3 (db:step-get-status step))
	   (vector-set! record 4 (db:step-get-event_time step))
	   (hash-table-set! res (db:step-get-stepname step) record)
	   (debug:print 6 "record(after)  = " record 
			"\nid:       " (db:step-get-id step)
			"\nstepname: " (db:step-get-stepname step)
			"\nstate:    " (db:step-get-state step)
			"\nstatus:   " (db:step-get-status step)
			"\ntime:     " (db:step-get-event_time step))))

    (set! results (list (cons "Runs" results)))
    ;; now, for each test, collect the test_data info and add a new sheet
    (for-each
     (lambda (test-id)
       (let ((test-data '())
	     (curr-test-name #f))
	 (sqlite3:for-each-row
	  (lambda (testname item_path category variable value comment)
	  (lambda (testname item_path category variable value comment status)
	    (set! curr-test-name testname)
	    (set! test-data (append test-data (list (list testname item_path category variable value comment)))))
	    (set! test-data (append test-data (list (list testname item_path category variable value comment status)))))
	  db 
	  "SELECT testname,item_path,category,variable,test_data.value AS value,expected_value,tol,units,test_data.comment AS comment FROM test_data INNER JOIN tests ON tests.id=test_data.test_id WHERE test_id=?;"
	  "SELECT testname,item_path,category,variable,td.value AS value,expected_value,tol,units,td.comment AS comment,td.status AS status FROM test_data AS td INNER JOIN tests ON tests.id=td.test_id WHERE test_id=?;"
	  test-id)
	 (if curr-test-name
	     (set! results (append results (list (cons curr-test-name test-data)))))
	 ))
     test-ids)
    (system (conc "mkdir -p " tempdir))
    ;; (pp results)

;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
    (general-run-call 
     "-rollup" 
     "rollup tests" 
     (lambda (db keys keynames keyvallst)
       (let ((n (args:get-arg "-rollup")))
	 (runs:rollup-run db keys)))))
       (runs:rollup-run db keys))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================

(if (args:get-arg "-extract-ods")
    (general-run-call

		  (if (null? tal)
		      (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
		      (loop (car tal)(cdr tal))))))))))

(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
  (let* ((real-status status)
	 (item-path   (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
	 (testdat     (db:get-test-info db run-id test-name item-path))
	 (test-id     (if testdat (db:test-get-id testdat) #f))
	 (otherdat    (if dat dat (make-hash-table)))
	 ;; before proceeding we must find out if the previous test (where all keys matched except runname)
	 ;; was WAIVED if this test is FAIL
	 (waived   (if (equal? status "FAIL")
		       (let ((prev-test (test:get-previous-test-run-record db run-id test-name item-path)))
			 (if prev-test ;; true if we found a previous test in this run series
			     (let ((prev-status (db:test-get-status   prev-test))

    (if waived (set! real-status "WAIVED"))
    (debug:print 4 "real-status " real-status ", waived " waived ", status " status)

    ;; 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)
    ;; :value

    (let ((val (hash-table-ref/default otherdat ":value" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET value=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; :expected_value
    (let ((val (hash-table-ref/default otherdat ":expected_value" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET expected_value=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; :tol
    (let ((val (hash-table-ref/default otherdat ":tol" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET tol=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; :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 ((val (hash-table-ref/default otherdat ":units" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET units=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; :tol_perc
    (let ((val (hash-table-ref/default otherdat ":tol_perc" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET tol_perc=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))

    ;; 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")

#!/bin/bash

exit 0

[setup]
runscript main.sh

[test_meta]
author matt
owner  bob
description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS

tags first,single
reviewed 09/10/2011, by Matt

#!/bin/bash

exit 1

[setup]
runscript main.sh

[test_meta]
author matt
owner  bob
description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS

tags first,single
reviewed 09/10/2011, by Matt

#!/bin/bash

$MT_MEGATEST -load-test-data << EOF
foo,bar,   1.2,  1.9, >
foo,rab, 1.0e9, 10e9, 1e9
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

# Needed to force rolling up the results and set the test to COMPLETED
$MT_MEGATEST -test-status :state COMPLETED :status AUTO

[setup]
runscript main.sh

[test_meta]
author matt
owner  bob
description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS

tags first,single
reviewed 09/10/2011, by Matt

#!/bin/bash

# category variable value expected  tol/comp units comment
$MT_MEGATEST -load-test-data << EOF
foo,       bar,     1.9,  1.8,      >
foo,       rab,   1.0e9,  2e9,      1e9
foo,       bla,     1.2,  1.9,      <
foo,       bal,    -1.1,    0,      <   ,         , 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

# Needed to force rolling up the results and set the test to COMPLETED
$MT_MEGATEST -test-status :state COMPLETED :status AUTO

[setup]
runscript main.sh

[test_meta]
author matt
owner  bob
description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS

tags first,single
reviewed 09/10/2011, by Matt

#!/bin/bash

# megatest -step wasting_time :state start :status n/a -m "This is a test step comment"
# sleep 20
# megatest -step wasting_time :state end :status $?

touch ../I_was_here

$MT_MEGATEST -runstep wasting_time -logpro wasting_time.logpro "sleep 8;echo all done eh?" -m "This is a test step comment"

$MT_MEGATEST -load-test-data << EOF
foo,bar,1.2,1.9,>
foo,rab,1.0e9,10e9,1e9
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" -set-toplog the_top_log.html :value 1e6 :expected_value 1.1e6 :tol 100e3
$MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" :value 0e6 :expected_value 1.1e6 :tol 100e3

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

  puts "i=#{i}"
end
if status==0
  status='pass'
else
  status='fail'
end


record_step("add #{num_records}","end",status)