Overview
Comment: | Inching along ... |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | inmem-per-run-db |
Files: | files | file ages | folders |
SHA1: |
84d0a584616163a692eb4865b8edf84e |
User & Date: | matt on 2013-11-26 21:53:39 |
Other Links: | branch diff | manifest | tags |
Context
2013-11-27
| ||
00:09 | Borked but better check-in: 2dc6168101 user: matt tags: inmem-per-run-db | |
2013-11-26
| ||
21:53 | Inching along ... check-in: 84d0a58461 user: matt tags: inmem-per-run-db | |
2013-11-25
| ||
23:58 | Getting there check-in: b47fdd6750 user: matt tags: inmem-per-run-db | |
Changes
Modified api.scm from [e11745624f] to [ce13ad7a8d].
︙ | |||
15 16 17 18 19 20 21 | 15 16 17 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 47 48 49 50 51 52 53 54 55 56 57 | - + - + - + - + | ;; These are called by the server on recipt of /api calls (define (api:execute-requests dbstruct cmd params) (case (string->symbol cmd) ;; KEYS ((get-key-val-pairs) (apply db:get-key-val-pairs dbstruct params)) |
︙ |
Modified db.scm from [72d96a4409] to [3d74afb53d].
︙ | |||
61 62 63 64 65 66 67 | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | - - - + + + | ;; mod-read: ;; 'mod modified data ;; 'read read data ;; (define (db:done-with dbstruct run-id mod-read) (mutex-lock! *rundb-mutex*) (if (eq? mod-read 'mod) |
︙ | |||
120 121 122 123 124 125 126 | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | - - + + - + | (if (and dbexists (not write-access)) (set! *db-write-access* #f)) ;; only unset so other db's also can use this control (if write-access (begin (sqlite3:set-busy-handler! db handler) (sqlite3:execute db "PRAGMA synchronous = 0;"))) (if (not dbexists)(db:initialize-run-id-db db)) |
︙ | |||
201 202 203 204 205 206 207 | 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 | - - + + | '("id" #f) '("run_id" #f) '("testname" #f) '("host" #f) '("cpuload" #f) '("diskfree" #f) '("uname" #f) |
︙ | |||
260 261 262 263 264 265 266 | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 | - - + + | '("id" #f) '("run_id" #f) '("testname" #f) '("host" #f) '("cpuload" #f) '("diskfree" #f) '("uname" #f) |
︙ | |||
477 478 479 480 481 482 483 | 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 | - - + + | (id INTEGER PRIMARY KEY, run_id INTEGER DEFAULT -1, testname TEXT DEFAULT 'noname', host TEXT DEFAULT 'n/a', cpuload REAL DEFAULT -1, diskfree INTEGER DEFAULT -1, uname TEXT DEFAULT 'n/a', |
︙ | |||
1107 1108 1109 1110 1111 1112 1113 | 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 | - + | ;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN ;; i.e. these lists define what to NOT show. ;; states and statuses are required to be lists, empty is ok ;; not-in #t = above behaviour, #f = must match (define (db:get-tests-for-run dbstruct run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals) (let* ((qryvalstr (case qryvals ((shortlist) "id,run_id,testname,item_path,state,status") |
︙ | |||
1180 1181 1182 1183 1184 1185 1186 | 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 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 | - + + + - - - - - - - + + + + + + + - + + + - - - - - - - + + + + + + + - - + + | (vector-ref inrec 4) ;; state (vector-ref inrec 5) ;; status -1 "" -1 -1 "" "-" (vector-ref inrec 3) ;; item-path -1 "-" "-")) |
︙ | |||
1326 1327 1328 1329 1330 1331 1332 | 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 | - + - + - + - + - + - + - + | (lambda (id) ;; run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment ) (set! res id)) ;; (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment ))) (db:get-db dbstruct run-id) "SELECT id FROM tests WHERE testname=? AND item_path=?;" testname item-path) res)) |
︙ | |||
1902 1903 1904 1905 1906 1907 1908 | 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 | - + | (let* ((unmet-pre-reqs '()) (result '())) (for-each (lambda (waitontest-name) ;; by getting the tests with matching name we are looking only at the matching test ;; and related sub items ;; next should be using mt:get-tests-for-run? |
︙ |
Modified db_records.scm from [7073c723c6] to [b201cba7e0].
︙ | |||
14 15 16 17 18 19 20 21 22 23 24 | 14 15 16 17 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 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | + + + + + + + + + + + + + + - + - - - + + + - + - + - + - - - - - - - - - - - - | (vector #f ;; the main db (contains runs, test_meta etc.) NOT CACHED IN MEM (make-hash-table) ;; run-id => [ rundb inmemdb last-mod last-read last-sync ] #f ;; the global string db (use for state, status etc.) path ;; path to database files/megatest area local)) ;; read-only local access ;; ;; Accessors for a dbstruct ;; ;; get and set main db (define-inline (dbr:dbstruct-get-main vec) (vector-ref vec 0)) (define-inline (dbr:dbstruct-set-main! vec db)(vector-set! vec 0 db)) ;; get the runs hash (define-inline (dbr:dbstruct-get-dbhash vec) (vector-ref vec 1)) ;; the string db (define-inline (dbr:dbstruct-get-strdb vec) (vector-ref vec 2)) (define-inline (dbr:dbstruct-set-strdb! vec db)(vector-set! vec 2 db)) ;; path (define-inline (dbr:dbstruct-get-path vec) (vector-ref vec 3)) (define-inline (dbr:dbstruct-set-path! vec path)(vector-set! vec 3)) ;; local (define-inline (dbr:dbstruct-get-local vec) (vector-ref vec 4)) (define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 4 val)) |
︙ |
Modified launch.scm from [ccd3899edb] to [207e8b581e].
︙ | |||
307 308 309 310 311 312 313 | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | - + | (- (current-seconds) start-seconds))))) (kill-tries 0)) (tests:set-full-meta-info test-id run-id (calc-minutes) work-area) (let loop ((minutes (calc-minutes))) (begin |
︙ | |||
343 344 345 346 347 348 349 | 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 | - + | ;; (begin ;; (debug:print 0 "Killing " (cadr parts) "; kill -9 " p-id) ;; (system (conc "kill -9 " p-id)))))) ;; (car processes)) ;; (system (conc "kill -9 -" pid)))) (begin (debug:print 0 "WARNING: Request received to kill job but problem with process, attempting to kill manager process") |
︙ | |||
498 499 500 501 502 503 504 | 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | - + - + - + | (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)) |
︙ | |||
659 660 661 662 663 664 665 | 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 | - + | (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all (diskpath #f) (cmdparms #f) (fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x)))) (mt-bindir-path #f) (item-path (item-list->path itemdat)) ;; (test-id (cdb:remote-run db:get-test-id #f run-id test-name item-path)) |
︙ |
Modified mt.scm from [f56eafe3d7] to [86cfab70c3].
︙ | |||
156 157 158 159 160 161 162 | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | - + - + - + - - - + + + | (conc "/" status))))))) ;;====================================================================== ;; S T A T E A N D S T A T U S F O R T E S T S ;;====================================================================== ;; speed up for common cases with a little logic |
︙ |
Modified rmt.scm from [5a1394abda] to [8b4a788096].
︙ | |||
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 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | - - + + - - + + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + | ;;====================================================================== ;; T E S T S ;;====================================================================== (define (rmt:get-test-id run-id testname item-path) (rmt:send-receive 'get-test-id (list run-id testname item-path))) |
︙ |
Modified runs.scm from [2bddd948f9] to [8f583e8498].
︙ | |||
157 158 159 160 161 162 163 | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 | - + - - + + | (currtime (current-seconds))) (if (> (- currtime lasttime) waitval) (begin (hash-table-set! *runs:denoise* key currtime) #t) #f))) |
︙ | |||
375 376 377 378 379 380 381 | 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 | - + | '() reg))) (define runs:nothing-left-in-queue-count 0) (define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records) (let* ((loop-list (list hed tal reg reruns)) |
︙ | |||
574 575 576 577 578 579 580 | 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 | - + - + | ((string? t) t) (else (conc t)))) inlst)) (define (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry) |
︙ | |||
620 621 622 623 624 625 626 | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 | - + - - + + | ;; Register tests ;; ((not (hash-table-ref/default test-registry (runs:make-full-test-name test-name item-path) #f)) (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" ) (if (eq? *transport-type* 'fs) ;; no point in parallel registration if use fs (begin |
︙ | |||
812 813 814 815 816 817 818 | 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 | - + | (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1))) ;; (debug:print 0 "max-tries-hash: " (hash-table->alist *max-tries-hash*)) ;; Ensure all top level tests get registered. This way they show up as "NOT_STARTED" on the dashboard ;; and it is clear they *should* have run but did not. (if (not (hash-table-ref/default test-registry (runs:make-full-test-name test-name "") #f)) (begin |
︙ | |||
928 929 930 931 932 933 934 | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 | - + | #f (loop (car tal)(cdr tal) reg reruns))) ;; if items is a proc then need to run items:get-items-from-config, get the list and loop ;; - but only do that if resources exist to kick off the job ;; EXPAND ITEMS ((or (procedure? items)(eq? items 'have-procedure)) |
︙ | |||
1035 1036 1037 1038 1039 1040 1041 | 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 | - + - + - + | (begin (hash-table-set! *test-meta-updated* test-name #t) (runs:update-test_meta test-name test-conf))) ;; itemdat => ((ripeness "overripe") (temperature "cool") (season "summer")) (let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/")) (test-id (rmt:get-test-id run-id test-name item-path)) |
︙ | |||
1132 1133 1134 1135 1136 1137 1138 | 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 | - + | (set! skip-test "Skipping due to previous tests running")))) ((and skip-check (configf:lookup test-conf "skip" "fileexists")) (if (file-exists? (configf:lookup test-conf "skip" "fileexists")) (set! skip-test (conc "Skipping due to existance of file " (configf:lookup test-conf "skip" "fileexists")))))) (if skip-test (begin |
︙ | |||
1258 1259 1260 1261 1262 1263 1264 | 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 | - + | (> (string-length dira)(string-length dirb)) #f))))) (test-retry-time (make-hash-table)) (allow-run-time 10)) ;; seconds to allow for killing tests before just brutally killing 'em (let loop ((test (car sorted-tests)) (tal (cdr sorted-tests))) (let* ((test-id (db:test-get-id test)) |
︙ | |||
1287 1288 1289 1290 1291 1292 1293 | 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 | - + - + - + | (hash-table-set! test-retry-time test-fulln (current-seconds)))) (if (> (- (current-seconds)(hash-table-ref test-retry-time test-fulln)) allow-run-time) ;; This test is not in a correct state for cleaning up. Let's try some graceful shutdown steps first ;; Set the test to "KILLREQ" and wait five seconds then try again. Repeat up to five times then give ;; up and blow it away. (begin (debug:print 0 "WARNING: could not gracefully remove test " test-fulln ", tried to kill it to no avail. Forcing state to FAILEDKILL and continuing") |
︙ | |||
1334 1335 1336 1337 1338 1339 1340 | 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 | - + | )) ;; Only delete the records *after* removing the directory. If things fail we have a record (rmt:delete-test-records (db:test-get-id test)) (if (not (null? tal)) (loop (car tal)(cdr tal)))))) ((set-state-status) (debug:print-info 2 "new state " (car state-status) ", new status " (cadr state-status)) |
︙ |
Modified tests.scm from [4ef747f90a] to [4c09716113].
︙ | |||
194 195 196 197 198 199 200 | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 | - + - + | result))))) (define (tests:test-force-state-status! test-id state status) (rmt:test-set-status-state test-id status state #f) (mt:process-triggers test-id state status)) ;; Do not rpc this one, do the underlying calls!!! |
︙ | |||
286 287 288 289 290 291 292 | 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 | - + - + | (if (not (equal? item-path "")) (rmt:roll-up-pass-fail-counts run-id test-name item-path status)) (if (or (and (string? comment) (string-match (regexp "\\S+") comment)) waived) (let ((cmt (if waived waived comment))) |
︙ | |||
586 587 588 589 590 591 592 | 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 | - - + + - - + + - + - + - + | ;;====================================================================== ;; test steps ;;====================================================================== ;; teststep-set-status! used to be here |
︙ |
Modified tests/unittests/dbrdbstruct.scm from [c136b1e628] to [174e159a1e].
︙ | |||
8 9 10 11 12 13 14 | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | + + - + + + + + + + + + + - - + + + | (test #f #t (vector? (make-dbr:dbstruct "/tmp"))) (define dbstruct (make-dbr:dbstruct "/tmp")) (test #f #t (begin (dbr:dbstruct-set-main! dbstruct "blah") #t)) (test #f "blah" (dbr:dbstruct-get-main dbstruct)) (for-each (lambda (run-id) |