497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
|
(debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up")))
(apply open-run-close-exception-handling proc idb params))
(apply open-run-close-no-exception-handling proc idb params)))
;; (define open-run-close
(define open-run-close open-run-close-exception-handling)
;; open-run-close-no-exception-handling
open-run-close-exception-handling)
;;)
(define (db:initialize-main-db db)
(let* ((configdat (car *configinfo*)) ;; tut tut, global warning...
(keys (keys:config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
|
|
|
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
|
(debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up")))
(apply open-run-close-exception-handling proc idb params))
(apply open-run-close-no-exception-handling proc idb params)))
;; (define open-run-close
(define open-run-close open-run-close-exception-handling)
;; open-run-close-no-exception-handling
;; open-run-close-exception-handling)
;;)
(define (db:initialize-main-db db)
(let* ((configdat (car *configinfo*)) ;; tut tut, global warning...
(keys (keys:config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
|
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
|
(db:general-call db 'top-test-set-running (list test-name))
(db:general-call db 'top-test-set-per-pf-counts (list test-name test-name test-name)))
#f)
#f))
(define (db:tests-register-test dbstruct run-id test-name item-path)
(sqlite3:execute (db:get-db dbstruct run-id) 'register-test run-id test-name item-path))
(let ((sleep-time (random 20))
(err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
(case err-status
((busy)(thread-sleep! 4))
(else
(debug:print 0 "WARNING: possible problem with call to cdb:remote-run, database may be read-only and locked, waiting and trying again ...")
(thread-sleep! sleep-time)))
(define (db:test-get-logfile-info dbstruct run-id test-name)
(let ((res #f))
(sqlite3:for-each-row
(lambda (path final_logf)
;; (let ((path (sdb:qry 'getstr path-id))
;; (final_logf (sdb:qry 'getstr final_logf-id)))
|
|
|
|
|
|
|
|
|
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
|
(db:general-call db 'top-test-set-running (list test-name))
(db:general-call db 'top-test-set-per-pf-counts (list test-name test-name test-name)))
#f)
#f))
(define (db:tests-register-test dbstruct run-id test-name item-path)
(sqlite3:execute (db:get-db dbstruct run-id) 'register-test run-id test-name item-path))
;; (let ((sleep-time (random 20))
;; (err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
;; (case err-status
;; ((busy)(thread-sleep! 4))
;; (else
;; (debug:print 0 "WARNING: possible problem with call to cdb:remote-run, database may be read-only and locked, waiting and trying again ...")
;; (thread-sleep! sleep-time)))
(define (db:test-get-logfile-info dbstruct run-id test-name)
(let ((res #f))
(sqlite3:for-each-row
(lambda (path final_logf)
;; (let ((path (sdb:qry 'getstr path-id))
;; (final_logf (sdb:qry 'getstr final_logf-id)))
|