Megatest

Check-in [2a59248c14]
Login
Overview
Comment:Bugs in new server/client code all fixed
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 2a59248c14b612889cc82a4fe2f8e83b1c63069f
User & Date: mrwellan on 2014-02-20 16:33:19
Other Links: branch diff | manifest | tags
Context
2014-02-22
14:20
Clean up fdktestqa check-in: 6e708371ee user: matt tags: v1.60
2014-02-20
16:33
Bugs in new server/client code all fixed check-in: 2a59248c14 user: mrwellan tags: v1.60
13:52
Fixed get-paths check-in: f1c76a256f user: mrwellan tags: v1.60
Changes

Modified db.scm from [e20f51655e] to [364892b873].

76
77
78
79
80
81
82

83
84
85
86
87
88
89
90
91
92










93
94
95
96
97
98
99
76
77
78
79
80
81
82
83










84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100







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







	(mutex-unlock! *rundb-mutex*))))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
  (let* ((db    (db:get-db dbstruct run-id))
	 )
	 (proc  (lambda ()
		  (let ((res (apply proc db params)))
		    (db:done-with dbstruct run-id r/w)
		    res))))
    (handle-exceptions
     exn
     (begin
       (thread-sleep! 10)
       (proc))
     (proc))))
    ;; (proc2 (lambda ()
    (let ((res (apply proc db params)))
      (db:done-with dbstruct run-id r/w)
      res)))
;;     (handle-exceptions
;;      exn
;;      (begin
;;        (thread-sleep! 10)
;;        (proc2))
;;      (proc2))))

;;======================================================================
;; K E E P   F I L E D B   I N   dbstruct
;;======================================================================

;; (define (db:get-filedb dbstruct run-id)
;;   (let ((db (vector-ref dbstruct 2)))
1189
1190
1191
1192
1193
1194
1195
1196

1197
1198
1199
1200
1201

1202
1203
1204
1205
1206
1207
1208
1190
1191
1192
1193
1194
1195
1196

1197
1198
1199
1200
1201

1202
1203
1204
1205
1206
1207
1208
1209







-
+




-
+







	 (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
    thekey))

;; Get run-ids for runs with same target but different runnames and NOT run-id
;;
(define (db:get-prev-run-ids dbstruct run-id)
  (let* ((keyvals (rmt:get-key-val-pairs run-id))
	 (kvalues (cdr keyvals))
	 (kvalues (map cadr keyvals))
	 (keys    (rmt:get-keys))
	 (qrystr  (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
    (let ((prev-run-ids '()))
      (db:with-db dbstruct #f #f ;; #f means work with the zeroth db - i.e. the runs db
       (lambda ()
       (lambda (db)
	 (apply sqlite3:for-each-row
		(lambda (id)
		  (set! prev-run-ids (cons id prev-run-ids)))
		db
		(conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append kvalues (list run-id)))))
      prev-run-ids)))