Megatest

Check-in [7c12fbc39a]
Login
Overview
Comment:More adjustments to inmem
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7c12fbc39a2545c4d3bf4523be4e0e47bfab0b0f
User & Date: matt on 2013-11-12 21:49:17
Other Links: manifest | tags
Context
2013-11-12
23:26
90% done with migration to inmem db check-in: 6b749d9f51 user: matt tags: trunk
21:49
More adjustments to inmem check-in: 7c12fbc39a user: matt tags: trunk
21:12
More ported to inmem check-in: 662f6304a0 user: matt tags: trunk
Changes

Modified api.scm from [41b5b06e44] to [306fb2ca21].

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
    ((get-prereqs-not-met)             (let ((res (apply db:get-prereqs-not-met db params)))
					 (map (lambda (x)
						(if (vector? x)
						    (vector->list x)
						    x))
					      res)))
    ((roll-up-pass-fail-counts)        (apply db:roll-up-pass-fail-counts db params))
    

    ;; RUNS
    ((get-run-info)                 (let ((res (apply db:get-run-info db params)))
				      (list (vector-ref res 0)
					    (vector->list (vector-ref res 1)))))
    ((register-run)                 (apply db:register-run db params))
    ((set-tests-state-status)       (apply db:set-tests-state-status db params))







|







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
    ((get-prereqs-not-met)             (let ((res (apply db:get-prereqs-not-met db params)))
					 (map (lambda (x)
						(if (vector? x)
						    (vector->list x)
						    x))
					      res)))
    ((roll-up-pass-fail-counts)        (apply db:roll-up-pass-fail-counts db params))
    ((update-fail-pass-counts)         (apply db:general-call db 'update-pass-fail-counts params))

    ;; RUNS
    ((get-run-info)                 (let ((res (apply db:get-run-info db params)))
				      (list (vector-ref res 0)
					    (vector->list (vector-ref res 1)))))
    ((register-run)                 (apply db:register-run db params))
    ((set-tests-state-status)       (apply db:set-tests-state-status db params))

Modified db.scm from [32892c2413] to [3ae86045c1].

1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
;;   (if (or *db-write-access*
;; 	  (not (member proc *db:all-write-procs*)))
;;       (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params)
;;       (begin
;; 	(debug:print 0 "ERROR: Attempt to access read-only database")
;; 	#f)))

(define (rmt:roll-up-pass-fail-counts run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
      (begin
	(db:general-call 'update-pass-fail-counts db (list run-id test-name run-id test-name))
	(if (equal? status "RUNNING")
	    (db:general-call 'top-test-set-running db (list run-id test-name))
	    (db:general-call 'top-test-set-per-pf-counts db (list run-id test-name run-id test-name)))







|







1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
;;   (if (or *db-write-access*
;; 	  (not (member proc *db:all-write-procs*)))
;;       (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params)
;;       (begin
;; 	(debug:print 0 "ERROR: Attempt to access read-only database")
;; 	#f)))

(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
      (begin
	(db:general-call 'update-pass-fail-counts db (list run-id test-name run-id test-name))
	(if (equal? status "RUNNING")
	    (db:general-call 'top-test-set-running db (list run-id test-name))
	    (db:general-call 'top-test-set-per-pf-counts db (list run-id test-name run-id test-name)))
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;")
	'(update-run-duration     "UPDATE tests SET run_duration=? WHERE id=?;")
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")
	'(update-test-state       "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	'(update-test-status      "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	;; stuff for roll-up-pass-fail-counts
	'(update-fail-pass-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
                 pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 







|







1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;")
	'(update-run-duration     "UPDATE tests SET run_duration=? WHERE id=?;")
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")
	'(update-test-state       "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	'(update-test-status      "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	;; stuff for roll-up-pass-fail-counts
	'(update-pass-fail-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
                 pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE run_id=? AND testname=? AND item_path='';")
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 

Modified rmt.scm from [00b9d433cf] to [59b3151e52].

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
       (if res
	   (rmt:json-str->dat res)
	   (begin
	     (debug:print 0 "ERROR: Bad value from http-transport:client-api-send-receive " res)
	     #f))
     ))
    (else
     (debug:print 0 "ERROR: Transport not yet (re)supported")
     (exit 1))))

;; Wrap json library for strings (why the ports crap in the first place?)
(define (rmt:dat->json-str dat)
  (with-output-to-string 
    (lambda ()
      (json-write dat))))







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
       (if res
	   (rmt:json-str->dat res)
	   (begin
	     (debug:print 0 "ERROR: Bad value from http-transport:client-api-send-receive " res)
	     #f))
     ))
    (else
     (debug:print 0 "ERROR: Transport " *transport-type* " not yet (re)supported")
     (exit 1))))

;; Wrap json library for strings (why the ports crap in the first place?)
(define (rmt:dat->json-str dat)
  (with-output-to-string 
    (lambda ()
      (json-write dat))))
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
(define (rmt:get-count-tests-running)
  (rmt:send-receive 'get-count-tests-running '()))

(define (rmt:get-count-tests-running-in-jobgroup jobgroup)
  (rmt:send-receive 'get-count-tests-running-in-jobgroup (list jobgroup)))

(define (rmt:roll-up-pass-fail-counts run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
      (begin
	(cdb:update-pass-fail-counts *runremote* run-id test-name)
	(if (equal? status "RUNNING")
	    (cdb:top-test-set-running *runremote* run-id test-name)
	    (cdb:top-test-set-per-pf-counts *runremote* run-id test-name))
	#f)
      #f))

(define (rmt:update-pass-fail-counts run-id test-name)
  (rmt:general-call 'update-fail-pass-counts run-id test-name run-id test-name run-id test-name))

;;======================================================================
;;  R U N S
;;======================================================================







<
<
<
|
<
<
<
<
<







170
171
172
173
174
175
176



177





178
179
180
181
182
183
184
(define (rmt:get-count-tests-running)
  (rmt:send-receive 'get-count-tests-running '()))

(define (rmt:get-count-tests-running-in-jobgroup jobgroup)
  (rmt:send-receive 'get-count-tests-running-in-jobgroup (list jobgroup)))

(define (rmt:roll-up-pass-fail-counts run-id test-name item-path status)



  (rmt:send-receive 'roll-up-pass-fail-counts (list run-id test-name item-path status)))






(define (rmt:update-pass-fail-counts run-id test-name)
  (rmt:general-call 'update-fail-pass-counts run-id test-name run-id test-name run-id test-name))

;;======================================================================
;;  R U N S
;;======================================================================

Modified tdb.scm from [b51589d681] to [d98014c985].

212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
	       ;; 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)(tdb: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







|







212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
	       ;; 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)(tdb:get-prev-tol-for-test tdb 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
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275

;; NOTE: Run this local with #f for db !!!
(define (tdb:load-test-data test-id #!key (work-area #f))
  (let loop ((lin (read-line)))
    (if (not (eof-object? lin))
	(begin
	  (debug:print 4 lin)
	  (tdb:csv->test-data db test-id lin work-area: work-area)
	  (loop (read-line)))))
  ;; roll up the current results.
  ;; FIXME: Add the status to 
  (tdb:test-data-rollup db test-id #f work-area: work-area))

;; WARNING: Do NOT call this for the parent test on an iterated test
;; Roll up test_data pass/fail results







|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275

;; NOTE: Run this local with #f for db !!!
(define (tdb:load-test-data test-id #!key (work-area #f))
  (let loop ((lin (read-line)))
    (if (not (eof-object? lin))
	(begin
	  (debug:print 4 lin)
	  (tdb:csv->test-data test-id lin work-area: work-area)
	  (loop (read-line)))))
  ;; roll up the current results.
  ;; FIXME: Add the status to 
  (tdb:test-data-rollup db test-id #f work-area: work-area))

;; WARNING: Do NOT call this for the parent test on an iterated test
;; Roll up test_data pass/fail results
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
	  ;;                  (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 (tdb:get-prev-tol-for-test test-id category variable)
  ;; Finish me?
  (values #f #f #f))

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








|







314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
	  ;;                  (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 (tdb:get-prev-tol-for-test tdb test-id category variable)
  ;; Finish me?
  (values #f #f #f))

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