Overview
Comment: | Merged |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
065043b224bf7870202f64eb2440ecd2 |
User & Date: | matt on 2015-05-28 22:55:44 |
Other Links: | branch diff | manifest | tags |
Context
2015-05-29
| ||
00:18 | db_sync test working. all_toplevel updated and PASS, turned on legacy sync check-in: c191fb998d user: matt tags: v1.60 | |
2015-05-28
| ||
22:55 | Merged check-in: 065043b224 user: matt tags: v1.60 | |
22:55 | Added basis for test of legacy vs. current db check-in: 0457c113cf user: matt tags: v1.60 | |
09:55 | Remove dotlock from opening dbs check-in: 3ebddba754 user: mrwellan tags: v1.60 | |
Changes
Modified common.scm from [005a48a275] to [c395efd7a6].
︙ | ︙ | |||
279 280 281 282 283 284 285 | (begin (sqlite3:interrupt! db) (sqlite3:finalize! db #t) (vector-set! *task-db* 0 #f)))))) "Cleanup db exit thread")) (th2 (make-thread (lambda () (debug:print 4 "Attempting clean exit. Please be patient and wait a few seconds...") (if no-hurry | | | | | | | 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 | (begin (sqlite3:interrupt! db) (sqlite3:finalize! db #t) (vector-set! *task-db* 0 #f)))))) "Cleanup db exit thread")) (th2 (make-thread (lambda () (debug:print 4 "Attempting clean exit. Please be patient and wait a few seconds...") (if no-hurry (thread-sleep! 5) ;; give the clean up few seconds to do it's stuff (thread-sleep! 2)) (debug:print 4 " ... done") ) "clean exit"))) (thread-start! th1) (thread-start! th2) (thread-join! th1)))) (define (std-signal-handler signum) ;; (signal-mask! signum) (set! *time-to-exit* #t) (debug:print 0 "ERROR: Received signal " signum " exiting promptly") ;; (std-exit-procedure) ;; shouldn't need this since we are exiting and it will be called anyway (exit)) |
︙ | ︙ |
Modified db.scm from [9ce696701e] to [74bdf209e7].
︙ | ︙ | |||
172 173 174 175 176 177 178 | (let* ((parent-dir (pathname-directory fname)) (dir-writable (file-write-access? parent-dir)) (file-exists (file-exists? fname)) (file-write (if file-exists (file-write-access? fname) dir-writable ))) (if file-write ;; dir-writable | | | | 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 | (let* ((parent-dir (pathname-directory fname)) (dir-writable (file-write-access? parent-dir)) (file-exists (file-exists? fname)) (file-write (if file-exists (file-write-access? fname) dir-writable ))) (if file-write ;; dir-writable (let (;; (lock (obtain-dot-lock fname 1 5 10)) (db (sqlite3:open-database fname))) (sqlite3:set-busy-handler! db (make-busy-timeout 136000)) (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = 0;") (if (not file-exists)(initproc db)) ;; (release-dot-lock fname) db) (begin (debug:print 0 "ERROR: no such db in non-writable dir " fname) (sqlite3:open-database fname))))) ;; ) ;; This routine creates the db. It is only called if the db is not already opened ;; |
︙ | ︙ | |||
1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 | (lambda (a . x) (set! res (cons (apply vector a x) res))) db qrystr ))) (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count) (vector header res))) ;; db:get-runs-by-patt ;; get runs by list of criteria ;; register a test run with the db ;; ;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) ;; to extract info from the structure returned | > > > > > > > > > > > > > > > > | 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 | (lambda (a . x) (set! res (cons (apply vector a x) res))) db qrystr ))) (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count) (vector header res))) (define (db:get-changed-run-ids since-time) (let* ((dbdir (db:dbfile-path #f)) ;; (configf:lookup *configdat* "setup" "dbdir")) (alldbs (glob (conc dbdir "/[0-9]*.db"))) (changed (filter (lambda (dbfile) (> (file-modification-time dbfile) since-time)) alldbs))) (delete-duplicates (map (lambda (dbfile) (let* ((res (string-match ".*\\/(\\d)*\\.db" dbfile))) (if res (string->number (cadr res)) (begin (debug:print 2 "WARNING: Failed to process " dbfile " for run-id") 0)))) changed)))) ;; db:get-runs-by-patt ;; get runs by list of criteria ;; register a test run with the db ;; ;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) ;; to extract info from the structure returned |
︙ | ︙ | |||
1812 1813 1814 1815 1816 1817 1818 | (runs-info '())) ;; First get all the runname/run-ids (db:delay-if-busy dbdat) (sqlite3:for-each-row (lambda (run-id runname) (set! runs-info (cons (list run-id runname) runs-info))) db | | | 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 | (runs-info '())) ;; First get all the runname/run-ids (db:delay-if-busy dbdat) (sqlite3:for-each-row (lambda (run-id runname) (set! runs-info (cons (list run-id runname) runs-info))) db "SELECT id,runname FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;") ;; If you change this to the more logical ASC please adjust calls to db:get-run-stats ;; for each run get stats data (for-each (lambda (run-info) ;; get the net state/status counts for this run (let* ((run-id (car run-info)) (run-name (cadr run-info))) (db:with-db |
︙ | ︙ |
Modified megatest.scm from [134d7dd741] to [9d3d552d20].
︙ | ︙ | |||
125 126 127 128 129 130 131 132 133 134 135 136 137 138 | -list-db-targets : list the target combinations used in the db -show-config : dump the internal representation of the megatest.config file -show-runconfig : dump the internal representation of the runconfigs.config file -dumpmode json : dump in json format instead of sexpr -show-cmdinfo : dump the command info for a test (run in test environment) -section sectionName -var varName : for config and runconfig lookup value for sectionName varName Misc -start-dir path : switch to this directory before running megatest -rebuild-db : bring the database schema up to date -cleanup-db : remove any orphan records, vacuum the db -import-megatest.db : migrate a database from v1.55 series to v1.60 series -sync-to-megatest.db : migrate data back to megatest.db | > | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | -list-db-targets : list the target combinations used in the db -show-config : dump the internal representation of the megatest.config file -show-runconfig : dump the internal representation of the runconfigs.config file -dumpmode json : dump in json format instead of sexpr -show-cmdinfo : dump the command info for a test (run in test environment) -section sectionName -var varName : for config and runconfig lookup value for sectionName varName -since N : get list of runs changed since time N (Unix seconds) Misc -start-dir path : switch to this directory before running megatest -rebuild-db : bring the database schema up to date -cleanup-db : remove any orphan records, vacuum the db -import-megatest.db : migrate a database from v1.55 series to v1.60 series -sync-to-megatest.db : migrate data back to megatest.db |
︙ | ︙ | |||
241 242 243 244 245 246 247 248 249 250 251 252 253 254 | "-dumpmode" "-run-id" "-ping" "-refdb2dat" "-o" "-log" "-archive" ) (list "-h" "-help" "--help" "-version" "-force" "-xterm" "-showkeys" "-show-keys" | > | 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 | "-dumpmode" "-run-id" "-ping" "-refdb2dat" "-o" "-log" "-archive" "-since" ) (list "-h" "-help" "--help" "-version" "-force" "-xterm" "-showkeys" "-show-keys" |
︙ | ︙ | |||
897 898 899 900 901 902 903 | (testpatt (if (args:get-arg "-testpatt") (args:get-arg "-testpatt") "%")) (keys (db:get-keys dbstruct)) ;; (runsdat (db:get-runs dbstruct runpatt #f #f '())) (runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target) #f #f)) | | > > > > > > > > > > > > > | 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 | (testpatt (if (args:get-arg "-testpatt") (args:get-arg "-testpatt") "%")) (keys (db:get-keys dbstruct)) ;; (runsdat (db:get-runs dbstruct runpatt #f #f '())) (runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target) #f #f)) (runstmp (db:get-rows runsdat)) (header (db:get-header runsdat)) (runs (if (and (not (null? runstmp)) (args:get-arg "-since")) (let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since"))))) (let loop ((hed (car runstmp)) (tal (cdr runstmp)) (res '())) (let ((new-res (if (member (db:get-value-by-header hed header "id") changed-ids) (cons hed res) res))) (if (null? tal) (reverse new-res) (loop (car tal)(cdr tal) new-res))))) runstmp)) (db-targets (args:get-arg "-list-db-targets")) (seen (make-hash-table)) (dmode (let ((d (args:get-arg "-dumpmode"))) (if d (string->symbol d) #f))) (data (make-hash-table))) ;; Each run (for-each |
︙ | ︙ | |||
933 934 935 936 937 938 939 | (print "Run: " targetstr "/" runname " status: " (db:get-value-by-header run header "state") " run-id: " run-id ", number tests: " (length tests)))) (for-each (lambda (test) (handle-exceptions exn | | | 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 | (print "Run: " targetstr "/" runname " status: " (db:get-value-by-header run header "state") " run-id: " run-id ", number tests: " (length tests)))) (for-each (lambda (test) (handle-exceptions exn (debug:print 4 "ERROR: Bad data in test record? " test) (let ((test-id (db:test-get-id test)) (fullname (conc (db:test-get-testname test) (if (equal? (db:test-get-item-path test) "") "" (conc "(" (db:test-get-item-path test) ")")))) (tstate (db:test-get-state test)) (tstatus (db:test-get-status test)) |
︙ | ︙ | |||
985 986 987 988 989 990 991 992 993 994 995 996 997 998 | (tdb:step-get-event_time step))) steps))))))))) tests))))) runs) (if (eq? dmode 'json)(json-write data)) (set! *didsomething* #t)))) ;;====================================================================== ;; full run ;;====================================================================== ;; get lock in db for full run for this directory ;; for all tests with deps ;; walk tree of tests to find head tasks | > > > > > > > > > > > | 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 | (tdb:step-get-event_time step))) steps))))))))) tests))))) runs) (if (eq? dmode 'json)(json-write data)) (set! *didsomething* #t)))) ;; Don't think I need this. Incorporated into -list-runs instead ;; ;; (if (and (args:get-arg "-since") ;; (launch:setup-for-run)) ;; (let* ((since-time (string->number (args:get-arg "-since"))) ;; (run-ids (db:get-changed-run-ids since-time))) ;; ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in) ;; (print (sort run-ids <)) ;; (set! *didsomething* #t))) ;;====================================================================== ;; full run ;;====================================================================== ;; get lock in db for full run for this directory ;; for all tests with deps ;; walk tree of tests to find head tasks |
︙ | ︙ |