Comment: | Merged in string db branch |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | inmem-per-run-db |
Files: | files | file ages | folders |
SHA1: |
3eb9a93e77dcbce4a381f30edf45a4a7 |
User & Date: | matt on 2013-11-24 18:17:37 |
Other Links: | branch diff | manifest | tags |
2013-11-24
| ||
20:16 | rundb, inmem and main structures written check-in: b81b7645b9 user: matt tags: inmem-per-run-db | |
18:17 | Merged in string db branch check-in: 3eb9a93e77 user: matt tags: inmem-per-run-db | |
13:51 | fixed typos check-in: 7ff3d03066 user: matt tags: inmem-per-run-db | |
2013-10-31
| ||
02:06 | yada Closed-Leaf check-in: e1254f35a8 user: matt tags: normalize-db | |
Modified Makefile from [ebc2ddac6d] to [2775c16066].
1 2 3 4 5 6 7 8 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | - + - + | # make install CSCOPTS='-accumulate-profile -profile-name $(PWD)/profile-ww$(shell date +%V.%u)' PREFIX=$(PWD) CSCOPTS= INSTALL=install SRCFILES = common.scm items.scm launch.scm \ ods.scm runconfig.scm server.scm configf.scm \ db.scm keys.scm margs.scm megatest-version.scm \ process.scm runs.scm tasks.scm tests.scm genexample.scm \ |
︙ |
Modified common.scm from [d0da8d6fd4] to [a28c1ed00f].
︙ | |||
91 92 93 94 95 96 97 98 99 100 101 102 103 104 | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | + + + + + | (set! *toptest-paths* (make-hash-table)) (set! *test-paths* (make-hash-table)) (set! *test-ids* (make-hash-table)) (set! *test-info* (make-hash-table)) (set! *run-info-cache* (make-hash-table)) (set! *env-vars-by-run-id* (make-hash-table)) (set! *test-id-cache* (make-hash-table))) ;; Generic string database (normalization of sorts) (define sdb:qry #f) ;; (make-sdb:qry)) ;; 'init #f) ;; Generic path database (normalization of sorts) (define *fdb* #f) ;;====================================================================== ;; S T A T E S A N D S T A T U S E S ;;====================================================================== (define *common:std-states* '((0 "COMPLETED") |
︙ |
Modified dashboard-tests.scm from [eb7584f776] to [33f393d42b].
︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | + + | (declare (unit dashboard-tests)) (declare (uses common)) (declare (uses db)) (declare (uses gutils)) (declare (uses rmt)) (declare (uses ezsteps)) (declare (uses sdb)) (declare (uses filedb)) (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") (define (test-info-panel testdat store-label widgets) (iup:frame |
︙ | |||
72 73 74 75 76 77 78 | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | - + | (db:test-get-status testdat)))) (iup:attribute-set! lbl "TITLE" (db:test-get-status testdat))))))) lbl) (store-label "testcomment" (iup:label "TestComment " #:expand "HORIZONTAL") (lambda (testdat) |
︙ | |||
179 180 181 182 183 184 185 | 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 | - + - + | "Run duration: " "Logfile: ")) (iup:label "" #:expand "VERTICAL"))) (apply iup:vbox ; #:expand "YES" (list ;; NOTE: Yes, the host can change! (store-label "HostName" |
︙ | |||
522 523 524 525 526 527 528 | 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 | - + | (db:get-test-info-by-id db test-id ))))) ;; (debug:print-info 0 "need-update= " need-update " curr-mod-time = " curr-mod-time) (cond ((and need-update newtestdat) (set! testdat newtestdat) (set! teststeps (dashboard-tests:get-compressed-steps db test-id)) (set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat))) |
︙ |
Modified dashboard.scm from [b8686db61f] to [f6eca51570].
︙ | |||
85 86 87 88 89 90 91 92 93 94 95 96 97 98 | 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | + + | (if (not (setup-for-run)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) (define *db* (open-db)) ;; (define sdb:qry (make-sdb:qry)) ;; 'init #f) ;; (if (args:get-arg "-host") ;; (begin ;; (set! *runremote* (string-split (args:get-arg "-host" ":"))) ;; (client:launch)) ;; (if (not (args:get-arg "-use-server")) ;; (set! *transport-type* 'fs) ;; force fs access |
︙ |
Modified db.scm from [decadcd6bd] to [80c8029823].
︙ | |||
26 27 28 29 30 31 32 33 34 35 36 37 38 39 | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | + | (declare (unit db)) (declare (uses common)) (declare (uses keys)) (declare (uses ods)) (declare (uses fs-transport)) (declare (uses client)) (declare (uses mt)) (declare (uses sdb)) (declare (uses filedb)) (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") (include "run_records.scm") |
︙ | |||
70 71 72 73 74 75 76 77 78 79 80 81 82 83 | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | + | (else (debug:print 0 "ERROR: synchronous must be 0,1,2,OFF,NORMAL or FULL, you provided: " syncval) #f)))) (if val (begin (debug:print-info 9 "db:set-sync, setting pragma synchronous to " val) (sqlite3:execute db (conc "PRAGMA synchronous = '" val "';")))))) ;; (sqlite3:execute db "PRAGMA synchronous = normal;")))) ;; need a default? ;;====================================================================== ;; K E E P F I L E D B I N dbstruct ;;====================================================================== (define (db:get-filedb dbstruct) (let ((db (vector-ref dbstruct 2))) |
︙ | |||
170 171 172 173 174 175 176 177 178 179 180 181 182 183 | 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | + + | (sqlite3:open-database fname)) (sqlite3:open-database ":memory:"))) (handler (make-busy-timeout 3600))) (if (or (not path) (not exists)) (db:initialize db)) (sqlite3:set-busy-handler! db handler) (set! sdb:qry (make-sdb:qry)) ;; we open the normalization helpers here (set! *fdb* (filedb:open-db (conc *toppath* "/db/paths.db"))) db)) ;; (define (db:sync-table tblname fields fromdb todb) (define (db:tbls db) (let ((keys (db:get-keys db))) (list |
︙ | |||
1049 1050 1051 1052 1053 1054 1055 | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 | - + | run-id) (debug:print-info 11 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr) (let ((finalres (vector header res))) ;; (hash-table-set! *run-info-cache* run-id finalres) finalres))) (define (db:set-comment-for-run dbstruct run-id comment) |
︙ | |||
1296 1297 1298 1299 1300 1301 1302 | 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 | - + - + | ;; speed up for common cases with a little logic ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id ;; (define (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus newcomment) (let ((db (db:get-db dbstruct run-id))) (cond ((and newstate newstatus newcomment) |
︙ | |||
1439 1440 1441 1442 1443 1444 1445 | 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 | - + + + | ;; S T E P S ;;====================================================================== (define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile) (sqlite3:execute db "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);" |
︙ | |||
1676 1677 1678 1679 1680 1681 1682 | 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 | - - - - - - + + + + + + | (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)) (define (db:test-get-logfile-info dbstruct run-id test-name) (let ((res #f)) (sqlite3:for-each-row (lambda (path-id final_logf-id) |
︙ |
Modified ezsteps.scm from [d31d8a3cf1] to [2065933577].
︙ | |||
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 | + + - + | (import (prefix sqlite3 sqlite3:)) (declare (unit ezsteps)) (declare (uses db)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) (declare (uses sdb)) (declare (uses filedb)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (define (ezsteps:run-from testdat start-step-name run-one) |
︙ |
Modified filedb.scm from [d77bc6ba17] to [91e90bcdc7].
︙ | |||
21 22 23 24 25 26 27 | 21 22 23 24 25 26 27 28 29 30 31 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 | - + + + + + + + + + | (dbexists (file-exists? dbpath)) (db (sqlite3:open-database dbpath))) (filedb:fdb-set-db! fdb db) (filedb:fdb-set-dbpath! fdb dbpath) (filedb:fdb-set-pathcache! fdb (make-hash-table)) (filedb:fdb-set-idcache! fdb (make-hash-table)) (filedb:fdb-set-partcache! fdb (make-hash-table)) |
︙ | |||
106 107 108 109 110 111 112 113 114 115 116 117 118 119 | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | + | (sqlite3:finalize! stmt))) (define (filedb:register-path fdb path #!key (save-stat #f)) (let* ((db (filedb:fdb-get-db fdb)) (pathcache (filedb:fdb-get-pathcache fdb)) (stat (if save-stat (file-stat path #t))) (id (hash-table-ref/default pathcache path #f))) (if (not db)(filedb:reopen-db fdb)) (if id id (let ((plist (string-split path "/"))) (let loop ((head (car plist)) (tail (cdr plist)) (parent 0)) (let ((id (filedb:get-path-id db head parent)) (done (null? tail))) |
︙ | |||
212 213 214 215 216 217 218 219 220 221 222 223 224 225 | 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 | + | parent-id search-patt) res)) (define (filedb:get-path fdb id) (let* ((db (filedb:fdb-get-db fdb)) (idcache (filedb:fdb-get-idcache fdb)) (path (hash-table-ref/default idcache id #f))) (if (not db)(filedb:reopen-db fdb)) (if path path (let loop ((curr-id id) (path "")) (let ((path-record (filedb:get-path-record fdb curr-id))) (if (not path-record) #f ;; this id has no path (let* ((parent-id (list-ref path-record 1)) (pname (list-ref path-record 0)) |
︙ |
Modified launch.scm from [48d32f2e0b] to [ccd3899edb].
︙ | |||
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | + + | (import (prefix base64 base64:)) (import (prefix sqlite3 sqlite3:)) (declare (unit launch)) (declare (uses common)) (declare (uses configf)) (declare (uses db)) (declare (uses sdb)) (declare (uses tdb)) (declare (uses filedb)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") ;;====================================================================== ;; ezsteps |
︙ | |||
495 496 497 498 499 500 501 502 503 504 505 506 507 508 | 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 | + | (if rd rd (conc *toppath* "/runs")))) (lnkbase (conc linktree "/" target "/" runname)) (lnkpath (conc lnkbase "/" testname)) (lnkpathf (conc lnkpath (if not-iterated "" "/") item-path))) ;; Update the rundir path in the test record for all ;; (cdb:test-set-rundir-by-test-id *runremote* test-id (filedb:register-path *fdb* lnkpathf)) (rmt:general-call 'test-set-rundir-by-test-id lnkpathf test-id) (debug:print 2 "INFO:\n lnkbase=" lnkbase "\n lnkpath=" lnkpath "\n toptest-path=" toptest-path "\n test-path=" test-path) (if (not (file-exists? linktree)) (begin (debug:print 0 "WARNING: linktree did not exist! Creating it now at " linktree) (create-directory linktree #t))) ;; (system (conc "mkdir -p " linktree)))) |
︙ | |||
516 517 518 519 520 521 522 | 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 | - + + | ;; thousands of unnecessary updates, cache the fact it was set and don't set it ;; again. ;; NB - This is not working right - some top tests are not getting the path set!!! (if (not (hash-table-ref/default *toptest-paths* testname #f)) (let* ((testinfo (rmt:get-test-info-by-id test-id)) ;; run-id testname item-path)) |
︙ |
Modified megatest.scm from [7ff16c8955] to [858e513fce].
︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | + + | (declare (uses launch)) (declare (uses server)) (declare (uses client)) (declare (uses tests)) (declare (uses genexample)) (declare (uses daemon)) (declare (uses db)) (declare (uses sdb)) (declare (uses filedb)) (declare (uses tdb)) (declare (uses mt)) (declare (uses api)) (define *db* #f) ;; this is only for the repl, do not use in general!!!! (include "common_records.scm") |
︙ | |||
236 237 238 239 240 241 242 243 244 245 246 247 248 249 | 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 | + + + | "-remove-runs" "-rebuild-db" "-cleanup-db" "-rollup" "-update-meta" "-gen-megatest-area" "-mark-incompletes" "-convert-to-norm" "-convert-to-old" "-logging" "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only ) args:arg-hash 0)) |
︙ | |||
625 626 627 628 629 630 631 | 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 | - - + + | (db:test-get-host test)) (if (not (or (equal? (db:test-get-status test) "PASS") (equal? (db:test-get-status test) "WARN") (equal? (db:test-get-state test) "NOT_STARTED"))) (begin (print " cpuload: " (db:test-get-cpuload test) "\n diskfree: " (db:test-get-diskfree test) |
︙ | |||
962 963 964 965 966 967 968 969 970 971 972 973 974 975 | 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 | + | (if (args:get-arg "-load-test-data") ;; has sub commands that are rdb: ;; DO NOT put this one into either cdb:remote-run or open-run-close (tdb:load-test-data test-id)) (if (args:get-arg "-setlog") (let ((logfname (args:get-arg "-setlog"))) ;; (cdb:test-set-log! *runremote* test-id (sdb:qry 'getid logfname)))) (rmt:test-set-log! test-id logfname))) (if (args:get-arg "-set-toplog") ;; DO NOT run remote (tests:test-set-toplog! run-id test-name (args:get-arg "-set-toplog"))) (if (args:get-arg "-summarize-items") ;; DO NOT run remote (tests:summarize-items db run-id test-id test-name #t)) ;; do force here |
︙ | |||
1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 | 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 | + | (oldexitstat exitstat) (cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " "))) (debug:print-info 2 "running \"" cmd "\"") (change-directory startingdir) (set! exitstat (system cmd)) (set! *globalexitstatus* exitstat) ;; no necessary (change-directory testpath) ;; (cdb:test-set-log! *runremote* test-id (sdb:qry 'getid htmllogfile)))) (rmt:test-set-log! test-id htmllogfile))) (let ((msg (args:get-arg "-m"))) (rmt:teststep-set-status! test-id stepname "end" exitstat msg logfile)) ))) (if (or (args:get-arg "-test-status") (args:get-arg "-set-values")) (let ((newstatus (cond |
︙ | |||
1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 | 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + | (or (get-environment-variable "HOME") ".") "/.megatest_history")) (current-input-port (make-gnu-readline-port "megatest> ")) (if (args:get-arg "-repl") (repl) (load (args:get-arg "-load")))) (exit)) (set! *didsomething* #t))) (if (args:get-arg "-convert-to-norm") (let* ((toppath (setup-for-run)) (db (if toppath (open-db) #f))) (for-each (lambda (field) (let ((dat '())) (debug:print-info 0 "Getting data for field " field) (sqlite3:for-each-row (lambda (id val) (set! dat (cons (list id val) dat))) db (conc "SELECT id," field " FROM tests;")) (debug:print-info 0 "found " (length dat) " items for field " field) (let ((qry (sqlite3:prepare db (conc "UPDATE tests SET " field "=? WHERE id=?;")))) (for-each (lambda (item) (let ((newval (sdb:qry 'getid (cadr item)))) (if (not (equal? newval (cadr item))) (debug:print-info 0 "Converting " (cadr item) " to " newval " for test #" (car item))) (sqlite3:execute qry newval (car item)))) dat) (sqlite3:finalize! qry)))) (list "uname" "rundir" "final_logf" "comment")) (set! *didsomething* #t))) ;;====================================================================== ;; Exit and clean up ;;====================================================================== (if *runremote* (close-all-connections!)) ;; this is the socket if we are a client ;; (if (and *runremote* ;; (socket? *runremote*)) ;; (close-socket *runremote*)) (if sdb:qry (sdb:qry 'finalize #f)) (if *fdb* (filedb:finalize-db! *fdb*)) (if (not *didsomething*) (debug:print 0 help)) ;; (if *runremote* (rpc:close-all-connections!)) (if (not (eq? *globalexitstatus* 0)) (if (or (args:get-arg "-runtests")(args:get-arg "-runall")) |
︙ |
Modified mt.scm from [0832843b45] to [f56eafe3d7].
︙ | |||
16 17 18 19 20 21 22 23 24 25 26 27 28 29 | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | + | (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) (declare (uses tests)) (declare (uses server)) (declare (uses runs)) (declare (uses rmt)) (declare (uses filedb)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") |
︙ | |||
124 125 126 127 128 129 130 | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | - + | ;;====================================================================== ;; T R I G G E R S ;;====================================================================== (define (mt:process-triggers test-id newstate newstatus) (let* ((test-dat (rmt:get-test-info-by-id test-id)) |
︙ |
Modified runs.scm from [9a63a1bcac] to [fd6be00df2].
︙ | |||
17 18 19 20 21 22 23 24 25 26 27 28 29 30 | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | + | (declare (uses db)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) (declare (uses tests)) (declare (uses server)) (declare (uses mt)) (declare (uses filedb)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") |
︙ | |||
1255 1256 1257 1258 1259 1260 1261 | 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 | - - + + - + | ((print-run) (debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header) action) ((run-wait) (debug:print 1 "Waiting for run " runkey ", run=" runnamepatt " to complete")) (else (debug:print-info 0 "action not recognised " action))) |
︙ |
Modified sdb.scm from [1de5adb23b] to [5d37256fc5].
︙ | |||
18 19 20 21 22 23 24 | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | - + - + - + - - | (use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64) (import (prefix sqlite3 sqlite3:)) (import (prefix base64 base64:)) (declare (unit sdb)) ;; |
︙ | |||
75 76 77 78 79 80 81 | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | + + - - + + - + - - - + + + + + + + + | (lambda (istr) (set! str istr) (hash-table-set! id-cache id str)) sdb "SELECT str FROM strs WHERE id=?;" id)) str)) ;; Numbers get passed though in both directions ;; |
Modified tests.scm from [1b82c72799] to [4ef747f90a].
︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | + | (declare (unit tests)) (declare (uses lock-queue)) (declare (uses db)) (declare (uses tdb)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) (declare (uses sdb)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") |
︙ | |||
131 132 133 134 135 136 137 | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | - - + + | #f)) ;; Check for waiver eligibility ;; (define (tests:check-waiver-eligibility testdat prev-testdat) (let* ((test-registry (make-hash-table)) (testconfig (tests:get-testconfig (db:test-get-testname testdat) test-registry #f)) |
︙ |
Modified zmq-transport.scm from [397cba74a4] to [1f9025d277].
| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | - + + |
|
︙ |