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 | 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: " |
︙ |
Modified dashboard-tests.scm from [b9845e18bc] to [c5b1c83cdb].
︙ | |||
413 414 415 416 417 418 419 | 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")) |
︙ |
Modified dashboard.scm from [b11af2b1c1] to [2973414ade].
︙ | |||
88 89 90 91 92 93 94 | 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")) |
︙ |
Modified db.scm from [804cf33a6b] to [57558c8677].
︙ | |||
40 41 42 43 44 45 46 | 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))) |
︙ | |||
103 104 105 106 107 108 109 | 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 |
︙ | |||
189 190 191 192 193 194 195 | 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 |
︙ | |||
279 280 281 282 283 284 285 | 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")) |
︙ | |||
574 575 576 577 578 579 580 | 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)) |
︙ | |||
721 722 723 724 725 726 727 | 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)) |
︙ | |||
763 764 765 766 767 768 769 | 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)) |
︙ | |||
839 840 841 842 843 844 845 | 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.") |
︙ | |||
3079 3080 3081 3082 3083 3084 3085 | 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 )) |
︙ | |||
3108 3109 3110 3111 3112 3113 3114 | 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) |
︙ |
Modified db_records.scm from [4c4fc29305] to [a0465e9dd6].
︙ | |||
14 15 16 17 18 19 20 21 22 23 24 25 26 27 | 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 | 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))) |
︙ |
Modified megatest.scm from [0cd2084f02] to [2b98b92e7f].
︙ | |||
953 954 955 956 957 958 959 | 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) |
︙ | |||
1484 1485 1486 1487 1488 1489 1490 | 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) |
︙ | |||
1790 1791 1792 1793 1794 1795 1796 | 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)) |
︙ |
Modified newdashboard.scm from [580f5bac48] to [ed60b2fe21].
︙ | |||
82 83 84 85 86 87 88 | 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")) |
︙ |
Modified rmt.scm from [58033889c8] to [ce331832c3].
︙ | |||
234 235 236 237 238 239 240 | 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")) |
︙ |
Modified tests/unittests/dbrdbstruct.scm from [347487983c] to [e78a243444].
1 2 3 4 5 6 7 8 9 | 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 |
︙ |
Modified tests/unittests/runs.scm from [d68c314e56] to [267c3ffa13].
︙ | |||
8 9 10 11 12 13 14 | 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" "")) |
︙ |