Overview
Comment: | Added migration to new format but -test-path not ported |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | normalize-db |
Files: | files | file ages | folders |
SHA1: |
541aae07659787ccd2179563bf1815b1 |
User & Date: | mrwellan on 2013-10-29 15:53:51 |
Other Links: | branch diff | manifest | tags |
Context
2013-10-30
| ||
00:03 | Switched paths to filedb check-in: 37693582eb user: matt tags: normalize-db | |
2013-10-29
| ||
15:53 | Added migration to new format but -test-path not ported check-in: 541aae0765 user: mrwellan tags: normalize-db | |
09:20 | Normalized rundir, uname and others check-in: 19769d349d user: mrwellan tags: normalize-db | |
Changes
Modified common.scm from [5b1dba8185] to [94de7ea81e].
︙ | |||
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 101 | + + + | (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) ;;====================================================================== ;; S T A T E S A N D S T A T U S E S ;;====================================================================== (define *common:std-states* (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "KILLED" "KILLREQ" "STUCK")) |
︙ |
Modified dashboard.scm from [5988625d24] to [9a1fc1c604].
︙ | |||
83 84 85 86 87 88 89 90 91 92 93 94 95 96 | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | + + | (if (not (setup-for-run)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) (define *db* #f) ;; (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 [b08cbf488a] to [6dd09b2808].
︙ | |||
82 83 84 85 86 87 88 89 90 91 92 93 94 95 | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | + | (not write-access)) (set! *db-write-access* write-access)) ;; only unset so other db's also can use this control (debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv)) (sqlite3:set-busy-handler! db handler) (if (not dbexists) (db:initialize db)) (db:set-sync db) (set! sdb:qry (make-sdb:qry)) ;; we open the normalization helpers here db)) ;; keeping it around for debugging purposes only (define (open-run-close-no-exception-handling proc idb . params) (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params) (let* ((db (if idb (if (procedure? idb) |
︙ | |||
1365 1366 1367 1368 1369 1370 1371 | 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 | - - + + | (set! res tpath)) db "SELECT rundir FROM tests WHERE id=?;" test-id) ;; (hash-table-set! *test-paths* test-id res) res)) ;; )) |
︙ | |||
1652 1653 1654 1655 1656 1657 1658 | 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 | - - - - - - + + + + + + + + | ;; db should be db open proc or #f (define (cdb:remote-run proc db . params) (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params)) (define (db:test-get-logfile-info db run-id test-name) (let ((res #f)) (sqlite3:for-each-row |
︙ |
Modified ezsteps.scm from [5bdb7484d4] to [7af8bc1e54].
︙ | |||
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 | + | (import (prefix sqlite3 sqlite3:)) (declare (unit ezsteps)) (declare (uses db)) (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") (define (ezsteps:run-from testdat start-step-name run-one) |
︙ | |||
96 97 98 99 100 101 102 | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | - + | (processloop (+ i 1)))) )) (let ((exinfo (vector-ref exit-info 2)) (logfna (if logpro-used (conc stepname ".html") ""))) ;; testing if procedures called in a remote call cause problems (ans: no or so I suspect) (db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna work-area: test-run-dir)) (if logpro-used |
︙ |
Modified launch.scm from [b994a7eaec] to [c19f7fffaa].
︙ | |||
254 255 256 257 258 259 260 | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 | - + | (processloop (+ i 1)))) )) (let ((exinfo (vector-ref exit-info 2)) (logfna (if logpro-used (conc stepname ".html") ""))) ;; testing if procedures called in a remote call cause problems (ans: no or so I suspect) (db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna work-area: work-area)) (if logpro-used |
︙ |
Modified megatest.scm from [28774d006a] to [d9a37585c9].
︙ | |||
235 236 237 238 239 240 241 242 243 244 245 246 247 248 | 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 | + + + | "-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)) |
︙ | |||
289 290 291 292 293 294 295 | 292 293 294 295 296 297 298 299 300 301 302 303 304 305 | - | ;; (hash-table-set! args:arg-hash "-transport" "fs")) ;;====================================================================== ;; Misc setup stuff ;;====================================================================== (debug:setup) |
︙ | |||
956 957 958 959 960 961 962 | 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 | - + | (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 (db:load-test-data db test-id work-area: work-area)) (if (args:get-arg "-setlog") (let ((logfname (args:get-arg "-setlog"))) |
︙ | |||
1002 1003 1004 1005 1006 1007 1008 | 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 | - + | (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) |
︙ | |||
1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 | 1155 1156 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 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 | + + + + + + + + + + + + + + + + + + + + + + + + + | (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!)) |
︙ |
Modified sdb.scm from [1de5adb23b] to [f2aeba1a5c].
︙ | |||
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 | - + - + | (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 | 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 ;; |