Overview
Comment: | Minor cleanup |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6569-multi-db-wip |
Files: | files | file ages | folders |
SHA1: |
d6e2d2990e3b240434dc90b7bc1c84cb |
User & Date: | matt on 2021-02-14 20:26:48 |
Other Links: | branch diff | manifest | tags |
Context
2021-02-14
| ||
22:34 | Sync bunch of minor changes with v1.65-real check-in: 0bf123a8c3 user: matt tags: v1.6569-multi-db-wip (unpublished) | |
20:26 | Minor cleanup check-in: d6e2d2990e user: matt tags: v1.6569-multi-db-wip (unpublished) | |
19:39 | cleanup some duplicated functions check-in: a1bb05ec00 user: matt tags: v1.6569-multi-db-wip (unpublished) | |
Changes
Modified api.scm from [c2151cc626] to [d5cec96c4e].
︙ | ︙ | |||
100 101 102 103 104 105 106 | (list-ref params 2) ; state (list-ref params 3) ; status (list-ref params 4) ; comment )) ((delete-test-records) (apply db:delete-test-records dbstruct params)) ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params)) | | < | 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | (list-ref params 2) ; state (list-ref params 3) ; status (list-ref params 4) ; comment )) ((delete-test-records) (apply db:delete-test-records dbstruct params)) ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params)) ((test-set-state-status) (apply db:test-set-state-status dbstruct params)) ((test-set-top-process-pid) (apply db:test-set-top-process-pid dbstruct params)) ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params)) ((set-state-status-and-roll-up-run) (apply db:set-state-status-and-roll-up-run dbstruct params)) ((top-test-set-per-pf-counts) (apply db:top-test-set-per-pf-counts dbstruct params)) ((test-set-archive-block-id) (apply db:test-set-archive-block-id dbstruct params)) ;; RUNS |
︙ | ︙ | |||
227 228 229 230 231 232 233 | ;; STEPS ((get-steps-data) (apply db:get-steps-data dbstruct params)) ((get-steps-for-test) (apply db:get-steps-for-test dbstruct params)) ((get-steps-info-by-id) (apply db:get-steps-info-by-id dbstruct params)) ;; TEST DATA ((read-test-data) (apply db:read-test-data dbstruct params)) | | | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 | ;; STEPS ((get-steps-data) (apply db:get-steps-data dbstruct params)) ((get-steps-for-test) (apply db:get-steps-for-test dbstruct params)) ((get-steps-info-by-id) (apply db:get-steps-info-by-id dbstruct params)) ;; TEST DATA ((read-test-data) (apply db:read-test-data dbstruct params)) ((read-test-data-varpatt) (apply db:read-test-data-varpatt dbstruct params)) ((get-data-info-by-id) (apply db:get-data-info-by-id dbstruct params)) ;; MISC ((get-latest-host-load) (apply db:get-latest-host-load dbstruct params)) ((have-incompletes?) (apply db:have-incompletes? dbstruct params)) ((login) (apply db:login dbstruct params)) ((general-call) (let ((stmtname (car params)) |
︙ | ︙ |
Modified commonmod.scm from [13fee5dc62] to [10014721ab].
︙ | ︙ | |||
298 299 300 301 302 303 304 | (handle-exceptions exn (begin (if message (debug:print-info 0 *default-log-port* message)) #f) (thunk) )) (define (common:file-exists? path-string #!key (silent #f)) | < | | | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 | (handle-exceptions exn (begin (if message (debug:print-info 0 *default-log-port* message)) #f) (thunk) )) (define (common:file-exists? path-string #!key (silent #f)) ;;;; TODO: catch permission denied exceptions and emit appropriate warnings. Might be able to get rid of with chicken 5? (common:false-on-exception (lambda () (file-exists? path-string)) message: (if (not silent) (conc "Unable to access path: " path-string) #f) )) (define (common:directory-exists? path-string) ;;;; TODO: catch permission denied exceptions and emit appropriate warnings (common:false-on-exception (lambda () (directory-exists? path-string)) message: (conc "Unable to access path: " path-string) )) ;; does the directory exist and do we have write access? ;; ;; returns the directory or #f |
︙ | ︙ |
Modified dbmod.scm from [c47894a6b4] to [32c65e5abc].
︙ | ︙ | |||
3551 3552 3553 3554 3555 3556 3557 | (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) db "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt) (reverse res))))) ;; This routine moved from tdb.scm, :read-test-data ;; | | | 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 | (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) db "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt) (reverse res))))) ;; This routine moved from tdb.scm, :read-test-data ;; (define (db:read-test-data-varpatt dbstruct run-id test-id categorypatt varpatt) (let* ((res '())) (db:with-db dbstruct #f #f (lambda (db) (sqlite3:for-each-row (lambda (id test_id category variable value expected tol units comment status type) (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) |
︙ | ︙ |
Modified megatest.scm from [d545af0e1a] to [09f7c5d29d].
︙ | ︙ | |||
1351 1352 1353 1354 1355 1356 1357 | (test-id (if (member "id" tests-spec)(get-value-by-fieldname test test-field-index "id" ) #f)) ;; (db:test-get-id test)) (testname (if (member "testname" tests-spec)(get-value-by-fieldname test test-field-index "testname" ) #f)) ;; (db:test-get-testname test)) (itempath (if (member "item_path" tests-spec)(get-value-by-fieldname test test-field-index "item_path" ) #f)) ;; (db:test-get-item-path test)) (fullname (conc testname (if (equal? itempath "") "" (conc "/" itempath )))) | | | 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 | (test-id (if (member "id" tests-spec)(get-value-by-fieldname test test-field-index "id" ) #f)) ;; (db:test-get-id test)) (testname (if (member "testname" tests-spec)(get-value-by-fieldname test test-field-index "testname" ) #f)) ;; (db:test-get-testname test)) (itempath (if (member "item_path" tests-spec)(get-value-by-fieldname test test-field-index "item_path" ) #f)) ;; (db:test-get-item-path test)) (fullname (conc testname (if (equal? itempath "") "" (conc "/" itempath )))) (testdat-raw (map vector->list (rmt:read-test-data-varpatt run-id test-id categorypatt setvarpatt))) (testdat (filter (lambda (x) (not (equal? "logpro" (list-ref x 10)))) testdat-raw))) (map (lambda (item) |
︙ | ︙ |
Modified rmt.scm from [30f81906bb] to [b5361867f1].
︙ | ︙ | |||
910 911 912 913 914 915 916 | ;;====================================================================== ;; T E S T D A T A ;;====================================================================== (define (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f)) (rmt:send-receive 'read-test-data run-id (list run-id test-id categorypatt))) | > | | | 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 | ;;====================================================================== ;; T E S T D A T A ;;====================================================================== (define (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f)) (rmt:send-receive 'read-test-data run-id (list run-id test-id categorypatt))) (define (rmt:read-test-data-varpatt run-id test-id categorypatt varpatt #!key (work-area #f)) (rmt:send-receive 'read-test-data-varpatt run-id (list run-id test-id categorypatt varpatt))) (define (rmt:get-data-info-by-id test-data-id) (rmt:send-receive 'get-data-info-by-id #f (list test-data-id))) (define (rmt:testmeta-add-record testname) (rmt:send-receive 'testmeta-add-record #f (list testname))) |
︙ | ︙ |