Overview
Comment: | some progress on unit tests |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | refactor-dbr:dbstruct |
Files: | files | file ages | folders |
SHA1: |
473832ad6fb69256d6698a87bce7b25b |
User & Date: | bjbarcla on 2016-01-28 11:00:03 |
Other Links: | branch diff | manifest | tags |
Context
2016-01-28
| ||
23:22 | Little bit further check-in: 8bf767b71b user: matt tags: refactor-dbr:dbstruct | |
11:00 | some progress on unit tests check-in: 473832ad6f user: bjbarcla tags: refactor-dbr:dbstruct | |
2016-01-26
| ||
18:39 | fixed db.scm to properly pass symbols (not strings) for keys of alist so alist->db:test calls work check-in: 90bb91e3b2 user: bjbarcla tags: refactor-dbr:dbstruct | |
Changes
Modified api.scm from [d4c6e4ffa0] to [36f919b0c4].
︙ | ︙ | |||
104 105 106 107 108 109 110 | ;; - returns #( flag result ) ;; (define (api:execute-requests dbstruct dat) (handle-exceptions exn (let ((call-chain (get-call-chain))) (print-call-chain (current-error-port)) | > | > > > > > > | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | ;; - returns #( flag result ) ;; (define (api:execute-requests dbstruct dat) (handle-exceptions exn (let ((call-chain (get-call-chain))) (print-call-chain (current-error-port)) (debug:print 0 " api:execute-requests/message: " ((condition-property-accessor 'exn 'message "exn message null") exn) " arguments: " ((condition-property-accessor 'exn 'arguments "exn arguments null") exn) " location: " ((condition-property-accessor 'exn 'location "exn location null") exn) ) (vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens (if (not (vector? dat)) ;; it is an error to not receive a vector (vector #f #f "remote must be called with a vector") (vector ;; return a vector + the returned data structure #t (let ((cmd (vector-ref dat 0)) (params (vector-ref dat 1))) |
︙ | ︙ |
Modified dashboard-tests.scm from [b9845e18bc] to [c5b1c83cdb].
︙ | ︙ | |||
413 414 415 416 417 418 419 | dlog)) ;;====================================================================== ;; ;;====================================================================== (define (examine-test run-id test-id) ;; run-id run-key origtest) (let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db")) | | | 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 | dlog)) ;;====================================================================== ;; ;;====================================================================== (define (examine-test run-id test-id) ;; run-id run-key origtest) (let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db")) (dbstruct (make-dbr:dbstruct-wrapper path: (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") local: #t)) (testdat (rmt:get-test-info-by-id run-id test-id)) ;; (db:get-test-info-by-id dbstruct run-id test-id)) (db-mod-time 0) ;; (file-modification-time db-path)) (last-update 0) ;; (current-seconds)) (request-update #t)) (if (not testdat) (begin |
︙ | ︙ |
Modified dashboard.scm from [b11af2b1c1] to [2973414ade].
︙ | ︙ | |||
88 89 90 91 92 93 94 | (print "Failed to find megatest.config, exiting") (exit 1))) (define *useserver* (or(not (args:get-arg "-use-local")) (configf:lookup *configdat* "dashboard" "use-server"))) (define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) | | | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | (print "Failed to find megatest.config, exiting") (exit 1))) (define *useserver* (or(not (args:get-arg "-use-local")) (configf:lookup *configdat* "dashboard" "use-server"))) (define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (define *dbstruct-local* (make-dbr:dbstruct-wrapper path: *dbdir* local: #t)) (define *db-file-path* (db:dbfile-path 0)) ;; HACK ALERT: this is a hack, please fix. (define *read-only* (not (file-read-access? *db-file-path*))) (define toplevel #f) |
︙ | ︙ |
Modified db.scm from [804cf33a6b] to [57558c8677].
︙ | ︙ | |||
40 41 42 43 44 45 46 | ;;====================================================================== ;; convert to -inline (define (db:first-result-default db stmt default . params) (handle-exceptions exn (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) | | | | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | ;;====================================================================== ;; convert to -inline (define (db:first-result-default db stmt default . params) (handle-exceptions exn (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message "exn message null") exn) (if (eq? err-status 'done) default (begin (debug:print 0 "ERROR: query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message "exn message null") exn)) (print-call-chain (current-error-port)) default))) (apply sqlite3:first-result db stmt params))) ;; Get/open a database ;; if run-id => get run specific db ;; if #f => get main db |
︙ | ︙ | |||
103 104 105 106 107 108 109 | (db:get-db dbstruct run-id) dbstruct)) ;; cheat, allow for passing in a dbdat (db (db:dbdat-get-db dbdat))) (db:delay-if-busy dbdat) (handle-exceptions exn (begin | | | 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 | (db:get-db dbstruct run-id) dbstruct)) ;; cheat, allow for passing in a dbdat (db (db:dbdat-get-db dbdat))) (db:delay-if-busy dbdat) (handle-exceptions exn (begin (debug:print 0 "ERROR: sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message "exn message null") exn)) (print-call-chain (current-error-port))) (let ((res (apply proc db params))) (if (vector? dbstruct)(db:done-with dbstruct run-id r/w)) res)))) ;;====================================================================== ;; K E E P F I L E D B I N dbstruct |
︙ | ︙ | |||
189 190 191 192 193 194 195 | (sqlite3:open-database fname))))) ;; ) ;; This routine creates the db. It is only called if the db is not already opened ;; (define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) (let* ((local (dbr:dbstruct-local dbstruct)) (rdb (if local | | | 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | (sqlite3:open-database fname))))) ;; ) ;; This routine creates the db. It is only called if the db is not already opened ;; (define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) (let* ((local (dbr:dbstruct-local dbstruct)) (rdb (if local (dbr:dbstruct-localdb dbstruct run-id) (dbr:dbstruct-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem))) (if (or rdb do-not-open) rdb (begin (mutex-lock! *rundb-mutex*) (let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db")) |
︙ | ︙ | |||
279 280 281 282 283 284 285 | (db:multi-db-sync #f 'old2new)) ;; migrate data from megatest.db automatically dbdat))))) ;; Make the dbstruct, setup up auxillary db's and call for main db at least once ;; (define (db:setup run-id #!key (local #f)) (let* ((dbdir (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) | | | 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 | (db:multi-db-sync #f 'old2new)) ;; migrate data from megatest.db automatically dbdat))))) ;; Make the dbstruct, setup up auxillary db's and call for main db at least once ;; (define (db:setup run-id #!key (local #f)) (let* ((dbdir (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (dbstruct (make-dbr:dbstruct-wrapper path: dbdir local: local))) dbstruct)) ;; Open the classic megatest.db file in toppath ;; (define (db:open-megatest-db) (let* ((dbpath (conc *toppath* "/megatest.db")) (dbexists (file-exists? dbpath)) |
︙ | ︙ | |||
574 575 576 577 578 579 580 | (mutex-lock! *db-sync-mutex*) (handle-exceptions exn (begin (mutex-unlock! *db-sync-mutex*) (debug:print 0 "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.") (print-call-chain (current-error-port)) | | | 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 | (mutex-lock! *db-sync-mutex*) (handle-exceptions exn (begin (mutex-unlock! *db-sync-mutex*) (debug:print 0 "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.") (print-call-chain (current-error-port)) (debug:print 0 " message: " ((condition-property-accessor 'exn 'message "exn message null") exn)) (print "exn=" (condition->list exn)) (debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn)) (debug:print 0 " src db: " (db:dbdat-get-path fromdb)) (for-each (lambda (dbdat) (let ((dbpath (db:dbdat-get-path dbdat))) (debug:print 0 " dbpath: " dbpath) (if (not (db:repair-db dbdat)) |
︙ | ︙ | |||
721 722 723 724 725 726 727 | ;; 'new2old - sync .db/{main,1,2,3 ...}.db to megatest.db ;; 'closeall - close all opened dbs ;; ;; run-ids: '(1 2 3 ...) or #f (for all) ;; (define (db:multi-db-sync run-ids . options) (let* ((toppath (launch:setup-for-run)) | | | 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 | ;; 'new2old - sync .db/{main,1,2,3 ...}.db to megatest.db ;; 'closeall - close all opened dbs ;; ;; run-ids: '(1 2 3 ...) or #f (for all) ;; (define (db:multi-db-sync run-ids . options) (let* ((toppath (launch:setup-for-run)) (dbstruct (if toppath (make-dbr:dbstruct-wrapper path: toppath) #f)) (mtdb (if toppath (db:open-megatest-db))) (allow-cleanup (if run-ids #f #t)) (run-ids (if run-ids run-ids (if toppath (begin (db:delay-if-busy mtdb) (db:get-all-run-ids mtdb))))) |
︙ | ︙ | |||
763 764 765 766 767 768 769 | (if (member 'old2new options) (begin (db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f)) (for-each (lambda (run-id) (db:delay-if-busy mtdb) (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)) | | | | | 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 | (if (member 'old2new options) (begin (db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f)) (for-each (lambda (run-id) (db:delay-if-busy mtdb) (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)) (dbstruct (if toppath (make-dbr:dbstruct-wrapper path: toppath local: #t) #f))) (debug:print 0 "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db") (db:replace-test-records dbstruct run-id testrecs) (sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct))))) run-ids))) ;; now ensure all newdb data are synced to megatest.db ;; do not use the run-ids list passed in to the function ;; (if (member 'new2old options) (let* ((maindb (make-dbr:dbstruct-wrapper path: toppath local: #t)) (src-run-ids (if run-ids run-ids (db:get-all-run-ids (db:dbdat-get-db (db:get-db maindb 0))))) (all-run-ids (sort (delete-duplicates (cons 0 src-run-ids)) <)) (count 1) (total (length all-run-ids)) (dead-runs '())) (for-each (lambda (run-id) (debug:print 0 "Processing run " (if (eq? run-id 0) " main.db " run-id) ", " count " of " total) (set! count (+ count 1)) (let* ((fromdb (if toppath (make-dbr:dbstruct-wrapper path: toppath local: #t) #f)) (frundb (db:dbdat-get-db (db:get-db fromdb run-id)))) ;; (db:delay-if-busy frundb) ;; (db:delay-if-busy mtdb) ;; (db:clean-up frundb) (if (eq? run-id 0) (begin (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb) |
︙ | ︙ | |||
839 840 841 842 843 844 845 | (let ((sleep-time (random 30)) (err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) (case err-status ((busy) (thread-sleep! sleep-time)) (else (debug:print 0 "EXCEPTION: database probably overloaded or unreadable.") | | | 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 | (let ((sleep-time (random 30)) (err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) (case err-status ((busy) (thread-sleep! sleep-time)) (else (debug:print 0 "EXCEPTION: database probably overloaded or unreadable.") (debug:print 0 " message: " ((condition-property-accessor 'exn 'message "exn message null") exn)) (print "exn=" (condition->list exn)) (debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn)) (print-call-chain (current-error-port)) (thread-sleep! sleep-time) (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))) |
︙ | ︙ | |||
3079 3080 3081 3082 3083 3084 3085 | ELSE 'UNKNOWN' END WHERE testname=? AND item_path='';") ;; DONE ;; STEPS '(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE test_id=?;") '(delete-test-data-records "UPDATE test_data SET status='DELETED' WHERE test_id=?;") ;; using status since no state field )) | | | | 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 | ELSE 'UNKNOWN' END WHERE testname=? AND item_path='';") ;; DONE ;; STEPS '(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE test_id=?;") '(delete-test-data-records "UPDATE test_data SET status='DELETED' WHERE test_id=?;") ;; using status since no state field )) ;;BB: db:lookup-query - called by db:general-call (define (db:lookup-query qry-name) (let ((q (alist-ref (if (string? qry-name) (string->symbol qry-name) qry-name) db:queries))) (if q (car q) #f))) ;; do not run these as part of the transaction (define db:special-queries '(rollup-tests-pass-fail ;; db:roll-up-pass-fail-counts ;; WHY NOT!? login immediate |
︙ | ︙ | |||
3108 3109 3110 3111 3112 3113 3114 | ((not (equal? megatest-version calling-version)) (list #f "Login failed due to mismatch megatest version: " calling-version ", " megatest-version)) (else (hash-table-set! *logged-in-clients* client-signature (current-seconds)) '(#t "successful login")))) (define (db:general-call dbdat stmtname params) | | | | | | > | 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 | ((not (equal? megatest-version calling-version)) (list #f "Login failed due to mismatch megatest version: " calling-version ", " megatest-version)) (else (hash-table-set! *logged-in-clients* client-signature (current-seconds)) '(#t "successful login")))) (define (db:general-call dbdat stmtname params) ;; (let ((query (let ((q (alist-ref (if (string? stmtname) ;; (string->symbol stmtname) ;; stmtname) ;; db:queries))) ;; (if q (car q) #f)))) (let ((query (db:lookup-query stmtname))) (db:delay-if-busy dbdat) (apply sqlite3:execute (db:dbdat-get-db dbdat) query params) #t)) ;; get a summary of state and status counts to calculate a rollup ;; ;; NOTE: takes a db, not a dbstruct |
︙ | ︙ |
Modified db_records.scm from [4c4fc29305] to [a0465e9dd6].
︙ | ︙ | |||
14 15 16 17 18 19 20 21 22 23 24 25 26 27 | ;; ;; Accessors for a dbstruct ;; (use defstruct) (defstruct dbr:dbstruct main strdb path local rundb inmem mtime rtime stime inuse refdb locdbs olddb rundb-path) ;;; (define d1 (make-dbr:dbstruct)) ;;; (dbr:dbstruct-main d1) ==> retrive value ;;; (dbr:dbstruct-main-set! d1 'def) ==> set value ;; (define-inline (dbr:dbstruct-get-main vec) (vector-ref vec 0)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-get-strdb vec) (vector-ref vec 1)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-get-path vec) (vector-ref vec 2)) | > > > > > > > > > > | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | ;; ;; Accessors for a dbstruct ;; (use defstruct) (defstruct dbr:dbstruct main strdb path local rundb inmem mtime rtime stime inuse refdb locdbs olddb rundb-path) ;; constructor for dbstruct ;; (define (make-dbr:dbstruct-wrapper #!key (path #f)(local #f)) (let ((res (make-dbr:dbstruct))) (dbr:dbstruct-path-set! res path) (dbr:dbstruct-local-set! res local) (dbr:dbstruct-locdbs-set! res (make-hash-table)) res)) ;;; (define d1 (make-dbr:dbstruct)) ;;; (dbr:dbstruct-main d1) ==> retrive value ;;; (dbr:dbstruct-main-set! d1 'def) ==> set value ;; (define-inline (dbr:dbstruct-get-main vec) (vector-ref vec 0)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-get-strdb vec) (vector-ref vec 1)) ;; ( db path ) ;; (define-inline (dbr:dbstruct-get-path vec) (vector-ref vec 2)) |
︙ | ︙ | |||
60 61 62 63 64 65 66 | ;; constructor for dbstruct ;; ;; BB: commenting out following 3 methods since they are unused ;; (define (actual-make-dbr:dbstruct #!key (path #f)(local #f)) ;; (make-dbr:dbstruct path: path local: local locdbs: (make-hash-table))) | | | | | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | ;; constructor for dbstruct ;; ;; BB: commenting out following 3 methods since they are unused ;; (define (actual-make-dbr:dbstruct #!key (path #f)(local #f)) ;; (make-dbr:dbstruct path: path local: local locdbs: (make-hash-table))) (define (dbr:dbstruct-localdb v run-id) (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f)) (define (dbr:dbstruct-localdb-set! v run-id db) (hash-table-set! (dbr:dbstruct-locdbs v) run-id db)) (defstruct db:test id run_id testname state status event_time host cpuload diskfree uname rundir item-path run_duration final_logf comment process_id pass_count fail_count archived ) ;; BB: 16ww4.3 begin comment out ;; (define (make-db:test)(make-vector 20)) ;; (define-inline (db:test-get-id vec) (vector-ref vec 0)) |
︙ | ︙ |
Modified megatest.scm from [0cd2084f02] to [2b98b92e7f].
︙ | ︙ | |||
953 954 955 956 957 958 959 | ;; NOTE: list-runs and list-db-targets operate on local db!!! ;; ;; IDEA: megatest list -runname blah% ... ;; (if (or (args:get-arg "-list-runs") (args:get-arg "-list-db-targets")) (if (launch:setup-for-run) | | | 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 | ;; NOTE: list-runs and list-db-targets operate on local db!!! ;; ;; IDEA: megatest list -runname blah% ... ;; (if (or (args:get-arg "-list-runs") (args:get-arg "-list-db-targets")) (if (launch:setup-for-run) (let* (;; (dbstruct (make-dbr:dbstruct-wrapper path: *toppath* local: (args:get-arg "-local"))) (runpatt (args:get-arg "-list-runs")) (testpatt (common:args-get-testpatt #f)) ;; (if (args:get-arg "-testpatt") ;; (args:get-arg "-testpatt") ;; "%")) (keys (rmt:get-keys)) ;; (db:get-keys dbstruct)) ;; (runsda t (db:get-runs dbstruct runpatt #f #f '())) |
︙ | ︙ | |||
1484 1485 1486 1487 1488 1489 1490 | ;;====================================================================== (if (args:get-arg "-extract-ods") (general-run-call "-extract-ods" "Make ods spreadsheet" (lambda (target runname keys keyvals) | | | 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 | ;;====================================================================== (if (args:get-arg "-extract-ods") (general-run-call "-extract-ods" "Make ods spreadsheet" (lambda (target runname keys keyvals) (let ((dbstruct (make-dbr:dbstruct-wrapper path: *toppath* local: #t)) (outputfile (args:get-arg "-extract-ods")) (runspatt (or (args:get-arg "-runname")(args:get-arg ":runname"))) (pathmod (args:get-arg "-pathmod"))) ;; (keyvalalist (keys->alist keys "%"))) (debug:print 2 "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvals: " keyvals) (db:extract-ods-file dbstruct outputfile keyvals (if runspatt runspatt "%") pathmod) (db:close-all dbstruct) |
︙ | ︙ | |||
1790 1791 1792 1793 1794 1795 1796 | ;;====================================================================== ;; fakeout readline (if (or (args:get-arg "-repl") (args:get-arg "-load")) (let* ((toppath (launch:setup-for-run)) | | | 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 | ;;====================================================================== ;; fakeout readline (if (or (args:get-arg "-repl") (args:get-arg "-load")) (let* ((toppath (launch:setup-for-run)) (dbstruct (if toppath (make-dbr:dbstruct-wrapper path: toppath local: (args:get-arg "-local")) #f))) (if dbstruct (begin (set! *db* dbstruct) (set! *client-non-blocking-mode* #t) (import extras) ;; might not be needed ;; (import csi) (import readline) |
︙ | ︙ |
Modified newdashboard.scm from [580f5bac48] to [ed60b2fe21].
︙ | ︙ | |||
82 83 84 85 86 87 88 | ;; ease debugging by loading ~/.dashboardrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) (define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) | | | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | ;; ease debugging by loading ~/.dashboardrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) (define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (define *dbstruct-local* (make-dbr:dbstruct-wrapper path: *dbdir* local: #t)) (define *db-file-path* (db:dbfile-path 0)) ;; HACK ALERT: this is a hack, please fix. (define *read-only* (not (file-read-access? *db-file-path*))) (debug:setup) |
︙ | ︙ |
Modified rmt.scm from [58033889c8] to [ce331832c3].
︙ | ︙ | |||
234 235 236 237 238 239 240 | (mutex-unlock! *db-stats-mutex*) res)) (define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)) (let* ((dbstruct-local (if *dbstruct-db* *dbstruct-db* (let* ((dbdir (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) | | | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | (mutex-unlock! *db-stats-mutex*) res)) (define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)) (let* ((dbstruct-local (if *dbstruct-db* *dbstruct-db* (let* ((dbdir (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (db (make-dbr:dbstruct-wrapper path: dbdir local: #t))) (set! *dbstruct-db* db) db))) (db-file-path (db:dbfile-path 0)) ;; (read-only (not (file-read-access? db-file-path))) (start (current-milliseconds)) (resdat (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))) (success (vector-ref resdat 0)) |
︙ | ︙ |
Modified tests/unittests/dbrdbstruct.scm from [347487983c] to [e78a243444].
1 2 3 4 5 6 7 8 9 | ;;====================================================================== ;; S E R V E R ;;====================================================================== ;; Run like this: ;; ;; (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) ;; BB: 2016-01-20 suspect this file is dead code | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | ;;====================================================================== ;; S E R V E R ;;====================================================================== ;; Run like this: ;; ;; (cd ..;make && make install) && ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0) ;; BB: 2016-01-20 suspect this file is dead code (test #f #t (dbr:dbstruct? (make-dbr:dbstruct-wrapper path: "/tmp"))) (define dbstruct (make-dbr:dbstruct-wrapper path: "/tmp")) (test #f #t (begin (dbr:dbstruct-main-set! dbstruct "blah") #t)) (test #f "blah" (dbr:dbstruct-main dbstruct)) (for-each (lambda (run-id) (test #f #t (vector? (dbr:dbstruct-get-rundb-rec dbstruct run-id)))) (list 1 2 3 4 5 6 7 8 9 #f)) |
︙ | ︙ |
Modified tests/unittests/runs.scm from [d68c314e56] to [267c3ffa13].
︙ | ︙ | |||
8 9 10 11 12 13 14 | "myrun" "new" "n/a" "bob"))) (test #f #t (rmt:register-test 1 "nada" "")) (test #f 30001 (rmt:get-test-id 1 "nada" "")) | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | "myrun" "new" "n/a" "bob"))) (test #f #t (rmt:register-test 1 "nada" "")) (test #f 30001 (rmt:get-test-id 1 "nada" "")) (test #f "NOT_STARTED" (db:test-state (rmt:get-test-info-by-id 1 30001))) ;; "nada" "") 3)) (test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def")) (test #f "key2" (vector-ref (car (vector-ref (mt:get-runs-by-patt '("SYSTEM" "RELEASE") "%" "key1/key2") 1)) 1)) (test #f "SYSTEM,RELEASE,id,runname,state,status,owner,event_time" (car (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))) (test #f #t (runs:operate-on 'print "%" "%" "%")) |
︙ | ︙ |