Megatest

Check-in [ad930701a2]
Login
Overview
Comment:rpc calls for iterated test rollup implemented and appears to work in remote mode
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | test-specific-db
Files: files | file ages | folders
SHA1: ad930701a23f91c5034628664acbcb7b5327bfef
User & Date: mrwellan on 2012-10-03 11:12:36
Other Links: branch diff | manifest | tags
Context
2012-10-03
16:46
rpc still partially borked check-in: f8d0d7ad8c user: mrwellan tags: test-specific-db
11:12
rpc calls for iterated test rollup implemented and appears to work in remote mode check-in: ad930701a2 user: mrwellan tags: test-specific-db
10:39
rpc calls for iterated test rollup implemented and working in local mode check-in: 0d2f1ac29a user: mrwellan tags: test-specific-db
Changes

Modified db.scm from [aa4fc1889f] to [8d7c726f88].

1258
1259
1260
1261
1262
1263
1264
1265

1266
1267
1268
1269
1270
1271
1272
1258
1259
1260
1261
1262
1263
1264

1265
1266
1267
1268
1269
1270
1271
1272







-
+








	  ;; Now rollup the counts to the central megatest.db
	  (sqlite3:execute db "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;" fail-count pass-count test-id)

	  (thread-sleep! 1) ;; play nice with the queue by ensuring the rollup is at least one second later than the set
	  
	  ;; if the test is not FAIL then set status based on the fail and pass counts.
	  (cdb:test-rollup-iterated-pass-fail test-id)
	  (rdb:test-rollup-iterated-pass-fail test-id)
	  ;; (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')
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579













1580
1567
1568
1569
1570
1571
1572
1573






1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587







-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

(define (rdb:open-run-close procname . remargs)
   (if *runremote*
       (let ((host (vector-ref *runremote* 0))
	     (port (vector-ref *runremote* 1)))
	 (apply (rpc:procedure 'rdb:open-run-close host port) procname remargs))
       (apply open-run-close (eval procname) remargs)))

;; (define (rdb:test-set-status-state procname . remargs)
;;    (if *runremote*
;;        (let ((host (vector-ref *runremote* 0))
;; 	     (port (vector-ref *runremote* 1)))
;; 	 (apply (rpc:procedure 'rdb:open-run-close host port) procname remargs))
;;        (apply open-run-close (eval procname) remargs)))
(define (rdb:test-set-status-state test-id status state)
   (if *runremote*
       (let ((host (vector-ref *runremote* 0))
	     (port (vector-ref *runremote* 1)))
	 (apply (rpc:procedure 'cdb:test-set-status-state host port) test-id status state))
       (cdb:test-set-status-state test-id status state)))

(define (rdb:test-rollup-iterated-pass-fail test-id)
   (if *runremote*
       (let ((host (vector-ref *runremote* 0))
	     (port (vector-ref *runremote* 1)))
	 (apply (rpc:procedure 'cdb:test-rollup-iterated-pass-fail host port) test-id))
       (cdb:test-rollup-iterated-pass-fail test-id)))

Modified server.scm from [a7dc2ad12d] to [bc742d4284].

70
71
72
73
74
75
76
77
78








79
80
81
82
83
84
85
70
71
72
73
74
75
76


77
78
79
80
81
82
83
84
85
86
87
88
89
90
91







-
-
+
+
+
+
+
+
+
+







	     (debug:print 4 "INFO: rdb:open-run-close " procname " " remargs)
	     (set! *last-db-access* (current-seconds))
	     (apply open-run-close (eval procname) remargs)))
	  
	  (rpc:publish-procedure!
	   'cdb:test-set-status-state
	   (lambda (test-id status state)
	     (debug:print 4 "INFO: cdb:test-set-status-state " procname " " remargs)
	     (apply cdb:test-set-status-state remargs)))
	     (debug:print 4 "INFO: cdb:test-set-status-state " test-id " " status "/" state)
	     (apply cdb:test-set-status-state test-id status statue)))

	  (rpc:publish-procedure!
	   'cdb:test-rollup-iterated-pass-fail
	   (lambda (test-id)
	     (debug:print 4 "INFO: cdb:test-rollup-iterated-pass-fail " test-id)
	     (apply cdb:test-rollup-iterated-pass-fail test-id)))

	  ;;======================================================================
	  ;; end of publish-procedure section
	  ;;======================================================================

	  (set! *rpc:listener* rpc:listener)
	  (on-exit (lambda ()

Modified tests.scm from [b7a51a2a27] to [ed832b54ab].

138
139
140
141
142
143
144
145

146
147
148
149
150
151
152
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152







-
+







		       #f)))
    (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)
	;; (rdb:open-run-close 'cdb:test-set-state-status #f test-id real-status state)) ;; this one works
	(cdb:test-set-status-state test-id real-status state))
	(rdb:test-set-status-state test-id real-status state))
    
    ;; if status is "AUTO" then call rollup (note, this one modifies data in test
    ;; run area, do not rpc it (yet)
    (if (and test-id state status (equal? status "AUTO")) 
	(open-run-close db:test-data-rollup db test-id status))

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