32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-data* '())
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex* (make-mutex))
(define *cache-on* #f)
(define (open-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
36000)))) ;; 136000)))
(debug:print 4 "INFO: dbpath=" dbpath)
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db))
(if (equal? (config-lookup *configdat* "setup" "synchronous") "yes")
(begin
(debug:print 5 "INFO: Turning off pragma synchronous")
(sqlite3:execute db "PRAGMA synchronous = 0;"))
(debug:print 5 "INFO: NOT turning off pragma synchronous"))
(if (equal? (config-lookup *configdat* "setup" "synchronous") "yes")
(sqlite3:execute db "PRAGMA synchronous = 0;"))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
<
<
<
|
<
<
|
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-data* '())
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex* (make-mutex))
(define *cache-on* #f)
(define (db:set-sync db)
(let* ((syncval (config-lookup *configdat* "setup" "synchronous"))
(val (cond ;; 0 | OFF | 1 | NORMAL | 2 | FULL;
((not syncval) #f)
((string->number syncval)
(let ((val (string->number syncval)))
(if (member val '(0 1 2)) val #f)))
((string-match (regexp "yes" #t) syncval) 1)
((string-match (regexp "no" #t) syncval) 0)
((string-match (regexp "(off|normal|full)" #t) syncval) syncval)
(else
(debug:print 0 "ERROR: synchronous must be 0,1,2,OFF,NORMAL or FULL, you provided: " syncval)
#f))))
(if val
(begin
(debug:print 2 "INFO: Setting pragma synchronous to " val)
(sqlite3:execute db (conc "PRAGMA synchronous = '" val "';"))))))
(define (open-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
36000)))) ;; 136000)))
(debug:print 4 "INFO: dbpath=" dbpath)
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db))
(db:set-sync db)
db))
(define (open-run-close proc idb . params)
(let* ((db (if idb idb (open-db)))
(res #f))
(db:set-sync db)
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
res))
(define *global-delta* 0)
(define *last-global-delta-printed* 0)
(define (open-run-close-measure proc idb . params)
|
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
|
'()
(let* ((unmet-pre-reqs '())
(result '()))
(for-each
(lambda (waitontest-name)
;; by getting the tests with matching name we are looking only at the matching test
;; and related sub items
(let ((tests (rdb:get-tests-for-run db run-id waitontest-name #f '() '()))
(ever-seen #f)
(parent-waiton-met #f)
(item-waiton-met #f))
(for-each
(lambda (test)
;; (if (equal? waitontest-name (db:test-get-testname test)) ;; by defintion this had better be true ...
(let* ((state (db:test-get-state test))
|
|
|
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
|
'()
(let* ((unmet-pre-reqs '())
(result '()))
(for-each
(lambda (waitontest-name)
;; by getting the tests with matching name we are looking only at the matching test
;; and related sub items
(let ((tests (db:get-tests-for-run db run-id waitontest-name #f '() '()))
(ever-seen #f)
(parent-waiton-met #f)
(item-waiton-met #f))
(for-each
(lambda (test)
;; (if (equal? waitontest-name (db:test-get-testname test)) ;; by defintion this had better be true ...
(let* ((state (db:test-get-state test))
|