Changes In Branch v1.63 Through [d6290cc32a] Excluding Merge-Ins
This is equivalent to a diff from bff9d56983 to d6290cc32a
2018-04-18
| ||
00:21 | No idea what this was. Commiting just in case it is interesting ... Leaf check-in: 33160354bc user: matt tags: dunno | |
2016-12-11
| ||
00:38 | Fixed -test-files (again). This is more useful than it might appear. It is able to find files even when the item path hierarchy changes. check-in: d6f19abb24 user: matt tags: v1.63 | |
00:12 | Committing automated merge of v1.63/d6290cc32a/integ into integ-home check-in: 060f5e8ec6 user: matt tags: integ-home | |
2016-12-10
| ||
23:58 | Added include from script output (requested many times) check-in: d6290cc32a user: matt tags: v1.63 | |
21:41 | Bumped version to v1.6302 check-in: e529772d43 user: matt tags: v1.63 | |
2016-12-05
| ||
13:11 | Bumped version to v1.6301 check-in: fbf0a07a1d user: mrwellan tags: v1.63, v1.6301 | |
12:58 | Protected calls to expensive ping with calls to cheap server:read-dotserver. This appears to 100% the run-away pings problem Closed-Leaf check-in: bff9d56983 user: mrwellan tags: v1.62-no-rpc | |
11:05 | Correct expiration of server connections check-in: b168adb943 user: mrwellan tags: v1.62-no-rpc | |
Modified NOTES from [fdf26c3763] to [24a602c385].
1 2 3 4 5 6 7 | ====================================================================== New way of launching needed to accomodate different target hosttypes for items ====================================================================== [flavors] | > > > > > > | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | ===================================================================== NOTES from looking at branch v1.62-rpc ===================================================================== *last-db-access* or *db-last-access* ==> which is it to be? seen in singletest: ERROR: Unrecognised arguments: :first_err This is the first error ====================================================================== New way of launching needed to accomodate different target hosttypes for items ====================================================================== [flavors] general ssh #{getbesthost general} nbgeneral nbjob run JOBCOMMAND -log $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME.$MT_TESTNAME-$MT_ITEM_PATH.lgo [hosts] general cubian xena [launchers] envsetup general |
︙ | ︙ |
Modified common.scm from [a3fcacf886] to [1afd768a71].
︙ | ︙ | |||
1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 | (map (lambda (res) (if (eof-object? res) 9e99 res)) (with-input-from-pipe (conc "ssh " remote-host " cat /proc/loadavg") (lambda ()(list (read)(read)(read))))) (with-input-from-file "/proc/loadavg" (lambda ()(list (read)(read)(read)))))) (define (common:wait-for-cpuload maxload numcpus waitdelay #!key (count 1000) (msg #f)(remote-host #f)) (let* ((loadavg (common:get-cpu-load remote-host)) (first (car loadavg)) (next (cadr loadavg)) (adjload (* maxload numcpus)) (loadjmp (- first next))) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 | (map (lambda (res) (if (eof-object? res) 9e99 res)) (with-input-from-pipe (conc "ssh " remote-host " cat /proc/loadavg") (lambda ()(list (read)(read)(read))))) (with-input-from-file "/proc/loadavg" (lambda ()(list (read)(read)(read)))))) ;; get normalized cpu load by reading from /proc/loadavg and /proc/cpuinfo return all three values and the number of real cpus and the number of threads ;; returns list (normalized-proc-load normalized-core-load 1m 5m 15m ncores nthreads) ;; (define (common:get-normalized-cpu-load remote-host) (let ((data (if remote-host (with-input-from-pipe (conc "ssh " remote-host " cat /proc/loadavg;cat /proc/cpuinfo;echo end") read-lines) (append (with-input-from-file "/proc/loadavg" read-lines) (with-input-from-file "/proc/cpuinfo" read-lines) (list "end")))) (load-rx (regexp "^([\\d\\.]+)\\s+([\\d\\.]+)\\s+([\\d\\.]+)\\s+.*$")) (proc-rx (regexp "^processor\\s+:\\s+(\\d+)\\s*$")) (core-rx (regexp "^core id\\s+:\\s+(\\d+)\\s*$")) (phys-rx (regexp "^physical id\\s+:\\s+(\\d+)\\s*$")) (max-num (lambda (p n)(max (string->number p) n)))) ;; (print "data=" data) (if (null? data) ;; something went wrong #f (let loop ((hed (car data)) (tal (cdr data)) (loads #f) (proc-num 0) ;; processor includes threads (phys-num 0) ;; physical chip on motherboard (core-num 0)) ;; core ;; (print hed ", " loads ", " proc-num ", " phys-num ", " core-num) (if (null? tal) ;; have all our data, calculate normalized load and return result (let* ((act-proc (+ proc-num 1)) (act-phys (+ phys-num 1)) (act-core (+ core-num 1)) (adj-proc-load (/ (car loads) act-proc)) (adj-core-load (/ (car loads) act-core))) (append (list (cons 'adj-proc-load adj-proc-load) (cons 'adj-core-load adj-core-load)) (list (cons '1m-load (car loads)) (cons '5m-load (cadr loads)) (cons '15m-load (caddr loads))) (list (cons 'proc act-proc) (cons 'core act-core) (cons 'phys act-phys)))) (regex-case hed (load-rx ( x l1 l5 l15 ) (loop (car tal)(cdr tal)(map string->number (list l1 l5 l15)) proc-num phys-num core-num)) (proc-rx ( x p ) (loop (car tal)(cdr tal) loads (max-num p proc-num) phys-num core-num)) (phys-rx ( x p ) (loop (car tal)(cdr tal) loads proc-num (max-num p phys-num) core-num)) (core-rx ( x c ) (loop (car tal)(cdr tal) loads proc-num phys-num (max-num c core-num))) (else (begin ;; (print "NO MATCH: " hed) (loop (car tal)(cdr tal) loads proc-num phys-num core-num))))))))) (define (common:wait-for-cpuload maxload numcpus waitdelay #!key (count 1000) (msg #f)(remote-host #f)) (let* ((loadavg (common:get-cpu-load remote-host)) (first (car loadavg)) (next (cadr loadavg)) (adjload (* maxload numcpus)) (loadjmp (- first next))) |
︙ | ︙ |
Modified configf.scm from [d9393dba52] to [ddff2b4e5d].
︙ | ︙ | |||
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | (caar cmdres))))) ;;====================================================================== ;; Make the regexp's needed globally available ;;====================================================================== (define configf:include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) (define configf:section-rx (regexp "^\\[(.*)\\]\\s*$")) (define configf:blank-l-rx (regexp "^\\s*$")) (define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$")) (define configf:key-val-pr (regexp "^(\\S+)(\\s+(.*)|())$")) (define configf:key-no-val (regexp "^(\\S+)(\\s*)$")) (define configf:comment-rx (regexp "^\\s*#.*")) (define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$")) (define configf:settings (regexp "^\\[configf:settings\\s+(\\S+)\\s+(\\S+)]\\s*$")) ;; read a line and process any #{ ... } constructs | > | | | > | | > > > > > | | | | | | | 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 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | (caar cmdres))))) ;;====================================================================== ;; Make the regexp's needed globally available ;;====================================================================== (define configf:include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$")) (define configf:script-rx (regexp "^\\[scriptinc\\s+(.*)\\]\\s*$")) ;; include output from a script (define configf:section-rx (regexp "^\\[(.*)\\]\\s*$")) (define configf:blank-l-rx (regexp "^\\s*$")) (define configf:key-sys-pr (regexp "^(\\S+)\\s+\\[system\\s+(\\S+.*)\\]\\s*$")) (define configf:key-val-pr (regexp "^(\\S+)(\\s+(.*)|())$")) (define configf:key-no-val (regexp "^(\\S+)(\\s*)$")) (define configf:comment-rx (regexp "^\\s*#.*")) (define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$")) (define configf:settings (regexp "^\\[configf:settings\\s+(\\S+)\\s+(\\S+)]\\s*$")) ;; read a line and process any #{ ... } constructs (define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get|rget|scm|sh|rp|gv|g|mtrah)\\s+([^\\}\\{]*)\\}(.*)")) (define (configf:process-line l ht allow-system #!key (linenum #f)) (let loop ((res l)) (if (string? res) (let ((matchdat (string-search configf:var-expand-regex res))) (if matchdat (let* ((prestr (list-ref matchdat 1)) (cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv (cmd (list-ref matchdat 3)) (poststr (list-ref matchdat 4)) (result #f) (start-time (current-seconds)) (cmdsym (string->symbol cmdtype)) (fullcmd (case cmdsym ((scheme scm) (conc "(lambda (ht)" cmd ")")) ((system) (conc "(lambda (ht)(system \"" cmd "\"))")) ((shell sh) (conc "(lambda (ht)(string-translate (shell \"" cmd "\") \"\n\" \" \"))")) ((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))")) ((getenv gv) (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))")) ((mtrah) (conc "(lambda (ht)" " (let ((extra \"" cmd "\"))" " (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))" " (if (string-null? extra) \"\" \"/\")" " extra)))")) ((get g) (let* ((parts (string-split cmd)) (sect (car parts)) (var (cadr parts))) (conc "(lambda (ht)(config-lookup ht \"" sect "\" \"" var "\"))"))) ((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) ;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) (else "(lambda (ht)(print \"ERROR\") \"ERROR\")")))) ;; (print "fullcmd=" fullcmd) (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\"") (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) ;; (print "exn=" (condition->list exn)) (set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd))) (if (or allow-system (not (member cmdtype '("system" "shell" "sh")))) (with-input-from-string fullcmd (lambda () (set! result ((eval (read)) ht)))) (set! result (conc "#{(" cmdtype ") " cmd "}")))) (case cmdsym ((system shell scheme) (let ((delta (- (current-seconds) start-time))) (if (> delta 2) (debug:print-info 0 *default-log-port* "for line \"" l "\"\n command: " cmd " took " delta " seconds to run with output:\n " result) (debug:print-info 9 *default-log-port* "for line \"" l "\"\n command: " cmd " took " delta " seconds to run with output:\n " result))))) (loop (conc prestr result poststr))) |
︙ | ︙ | |||
180 181 182 183 184 185 186 | ;; in the environment on the fly ;; sections: #f => get all, else list of sections to gather ;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path) ;; (define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f)(settings (make-hash-table))(keep-filenames #f)(post-section-procs '())) (debug:print-info 5 *default-log-port* "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory)) (debug:print 9 *default-log-port* "START: " path) | > | | > > > | | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | ;; in the environment on the fly ;; sections: #f => get all, else list of sections to gather ;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path) ;; (define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f)(settings (make-hash-table))(keep-filenames #f)(post-section-procs '())) (debug:print-info 5 *default-log-port* "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory)) (debug:print 9 *default-log-port* "START: " path) (if (and (not (port? path)) (not (file-exists? path))) ;; for case where we are handed a port (begin (debug:print-info 1 *default-log-port* "read-config - file not found " path " current path: " (current-directory)) ;; WARNING: This is a risky change but really, we should not return an empty hash table if no file read? #f) ;; (if (not ht)(make-hash-table) ht)) (let ((inp (if (string? path) (open-input-file path) path)) ;; we can be handed a port (res (if (not ht)(make-hash-table) ht)) (metapath (if (or (debug:debug-mode 9) keep-filenames) path #f))) (let loop ((inl (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings)) ;; (read-line inp)) (curr-section-name (if curr-section curr-section "default")) (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere (lead #f)) (debug:print-info 8 *default-log-port* "curr-section-name: " curr-section-name " var-flag: " var-flag "\n inl: \"" inl "\"") (if (eof-object? inl) (begin (if (string? path) ;; we received a path, not a port, thus we are responsible for closing it. (close-input-port inp)) (hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht (debug:print 9 *default-log-port* "END: " path) res) (regex-case inl (configf:comment-rx _ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) (configf:blank-l-rx _ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) |
︙ | ︙ | |||
227 228 229 230 231 232 233 234 235 236 237 238 239 240 | (read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames) ;; (pop-directory) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) (begin (debug:print '(2 9) #f "INFO: include file " include-file " not found (called from " path ")") (debug:print 2 *default-log-port* " " full-conf) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))) (configf:section-rx ( x section-name ) (begin ;; call post-section-procs (for-each (lambda (dat) (let ((patt (car dat)) (proc (cdr dat))) (if (string-match patt curr-section-name) | > > > > > > > > > > > > > > > > | 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 | (read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames) ;; (pop-directory) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) (begin (debug:print '(2 9) #f "INFO: include file " include-file " not found (called from " path ")") (debug:print 2 *default-log-port* " " full-conf) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))))) (configf:script-rx ( x include-script );; handle-exceptions ;; exn ;; (begin ;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.") ;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) (if (and (file-exists? include-script)(file-execute-access? include-script)) (let* ((new-inp-port (open-input-pipe include-script))) (debug:print '(2 9) *default-log-port* "Including from script output: " include-script) ;; (print "We got here, calling read-config next. Port is: " new-inp-port) (read-config new-inp-port res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames) (close-input-port new-inp-port) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) (begin (debug:print 0 *default-log-port* "Script not found or not exectutable: " include-script) (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))) ) ;; ) (configf:section-rx ( x section-name ) (begin ;; call post-section-procs (for-each (lambda (dat) (let ((patt (car dat)) (proc (cdr dat))) (if (string-match patt curr-section-name) |
︙ | ︙ |
Modified db.scm from [b74c06eb1c] to [b8a881530e].
︙ | ︙ | |||
191 192 193 194 195 196 197 | ;; ;; (define db:get-dbdir common:get-db-tmp-area) ;; (or (configf:lookup *configdat* "setup" "dbdir") ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))) (define (db:set-sync db) (let ((syncprag (configf:lookup *configdat* "setup" "sychronous"))) | | | | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | ;; ;; (define db:get-dbdir common:get-db-tmp-area) ;; (or (configf:lookup *configdat* "setup" "dbdir") ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))) (define (db:set-sync db) (let ((syncprag (configf:lookup *configdat* "setup" "sychronous"))) (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 0) ";")))) ;; open an sql database inside a file lock ;; returns: db existed-prior-to-opening ;; RA => Returns a db handler; sets the lock if opened in writable mode ;; (define (db:lock-create-open fname initproc) (let* ((parent-dir (or (pathname-directory fname)(current-directory))) ;; no parent? go local (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) (begin (if (string-match "^/tmp/.*" fname) ;; this is a file in /tmp (sqlite3:execute db "PRAGMA journal_mode=WAL;") (print "Creating " fname " in NON-WAL mode.")) (initproc db))) ;; (release-dot-lock fname) |
︙ | ︙ | |||
737 738 739 740 741 742 743 | (define (db:get-access-mode) (if (args:get-arg "-use-db-cache") 'cached 'rmt)) ;; Add db direct ;; (define (db:dispatch-query access-mode rmt-cmd db-cmd . params) (if (eq? access-mode 'cached) | | | 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 | (define (db:get-access-mode) (if (args:get-arg "-use-db-cache") 'cached 'rmt)) ;; Add db direct ;; (define (db:dispatch-query access-mode rmt-cmd db-cmd . params) (if (eq? access-mode 'cached) (debug:print 2 *default-log-port* "not doing cached calls right now")) ;; (apply db:call-with-cached-db db-cmd params) (apply rmt-cmd params)) ;;) ;; return the target db handle so it can be used ;; (define (db:cache-for-read-only source target #!key (use-last-update #f)) |
︙ | ︙ | |||
1497 1498 1499 1500 1501 1502 1503 | (min-incompleted-ids (map car incompleted)) ;; do 'em all (all-ids (append min-incompleted-ids (map car oldlaunched)))) (if (> (length all-ids) 0) (begin (debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE") (sqlite3:execute db | | | > | 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 | (min-incompleted-ids (map car incompleted)) ;; do 'em all (all-ids (append min-incompleted-ids (map car oldlaunched)))) (if (> (length all-ids) 0) (begin (debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE") (sqlite3:execute db (conc "UPDATE tests SET state='INCOMPLETE' WHERE run_id=? AND id IN (" (string-intersperse (map conc all-ids) ",") ");") run-id)))) ;; Now do rollups for the toplevel tests ;; ;; (db:delay-if-busy dbdat) (for-each (lambda (toptest) (let ((test-name (list-ref toptest 3))) |
︙ | ︙ | |||
3052 3053 3054 3055 3056 3057 3058 3059 3060 | (sqlite3:for-each-row (lambda (rid) (set! row-ids (cons rid row-ids))) runsqry) (sqlite3:finalize! runsqry) row-ids)) (define (db:test-get-paths-matching-keynames-target-new dbstruct run-id keynames target res testpatt statepatt statuspatt runname) (let* ((testqry (tests:match->sqlqry testpatt)) | > > | | > | 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 | (sqlite3:for-each-row (lambda (rid) (set! row-ids (cons rid row-ids))) runsqry) (sqlite3:finalize! runsqry) row-ids)) ;; finds latest matching all patts for given run-id ;; (define (db:test-get-paths-matching-keynames-target-new dbstruct run-id keynames target res testpatt statepatt statuspatt runname) (let* ((testqry (tests:match->sqlqry testpatt)) (tstsqry (conc "SELECT rundir FROM tests WHERE run_id=? AND " testqry " AND state LIKE '" statepatt "' AND status LIKE '" statuspatt "' ORDER BY event_time ASC;"))) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (p) (set! res (cons p res))) db tstsqry run-id) res)))) (define (db:test-toplevel-num-items dbstruct run-id testname) (db:with-db dbstruct run-id #f |
︙ | ︙ | |||
3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 | ;; '(test-set-rundir "UPDATE tests SET rundir=? AND testname=? AND item_path=?;") ;; DONE '(test-set-rundir-shortdir "UPDATE tests SET rundir=?,shortdir=? WHERE testname=? AND item_path=? AND run_id=?;") ;; BROKEN!!! NEEDS run-id '(delete-tests-in-state ;; "DELETE FROM tests WHERE state=?;") ;; DONE "UPDATE tests SET state='DELETED' WHERE state=?") '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") '(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") ;; DONE '(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;") ;; DONE '(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") '(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") ;; stuff for roll-up-pass-fail-counts '(update-pass-fail-counts "UPDATE tests SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK','INCOMPLETE','ABORT')), pass_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED')) WHERE testname=? AND item_path='' AND run_id=?;") ;; DONE ;; BROKEN!!! NEEDS run-id | > | 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 | ;; '(test-set-rundir "UPDATE tests SET rundir=? AND testname=? AND item_path=?;") ;; DONE '(test-set-rundir-shortdir "UPDATE tests SET rundir=?,shortdir=? WHERE testname=? AND item_path=? AND run_id=?;") ;; BROKEN!!! NEEDS run-id '(delete-tests-in-state ;; "DELETE FROM tests WHERE state=?;") ;; DONE "UPDATE tests SET state='DELETED' WHERE state=?") '(tests:test-set-toplog "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';") '(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") ;; DONE '(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;") ;; DONE '(update-test-rundat "INSERT INTO test_rundat (test_id,update_time,cpuload,diskfree,diskusage,run_duration) VALUES (?,?,?,?,?,?);") '(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") '(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") ;; stuff for roll-up-pass-fail-counts '(update-pass-fail-counts "UPDATE tests SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK','INCOMPLETE','ABORT')), pass_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED')) WHERE testname=? AND item_path='' AND run_id=?;") ;; DONE ;; BROKEN!!! NEEDS run-id |
︙ | ︙ |
Modified docs/manual/megatest_manual.html from [2d6199dc08] to [04def7fcd5].
1 2 3 4 | <!DOCTYPE html> <html lang="en"> <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> | | | 1 2 3 4 5 6 7 8 9 10 11 12 | <!DOCTYPE html> <html lang="en"> <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> <meta name="generator" content="AsciiDoc 8.6.9"> <title>The Megatest Users Manual</title> <style type="text/css"> /* Shared CSS for AsciiDoc xhtml11 and html5 backends */ /* Default font. */ body { font-family: Georgia,serif; |
︙ | ︙ | |||
82 83 84 85 86 87 88 | ul, ol, li > p { margin-top: 0; } ul > li { color: #aaa; } ul > li > * { color: black; } | | > > > > > > | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | ul, ol, li > p { margin-top: 0; } ul > li { color: #aaa; } ul > li > * { color: black; } .monospaced, code, pre { font-family: "Courier New", Courier, monospace; font-size: inherit; color: navy; padding: 0; margin: 0; } pre { white-space: pre-wrap; } #author { color: #527bbd; font-weight: bold; font-size: 1.1em; } #email { |
︙ | ︙ | |||
214 215 216 217 218 219 220 | div.exampleblock > div.content { border-left: 3px solid #dddddd; padding-left: 0.5em; } div.imageblock div.content { padding-left: 0; } | | | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 | div.exampleblock > div.content { border-left: 3px solid #dddddd; padding-left: 0.5em; } div.imageblock div.content { padding-left: 0; } span.image img { border-style: none; vertical-align: text-bottom; } a.image:visited { color: white; } dl { margin-top: 0.8em; margin-bottom: 0.8em; } dt { |
︙ | ︙ | |||
410 411 412 413 414 415 416 | /* * xhtml11 specific * * */ | < < < < < < | 416 417 418 419 420 421 422 423 424 425 426 427 428 429 | /* * xhtml11 specific * * */ div.tableblock { margin-top: 1.0em; margin-bottom: 1.5em; } div.tableblock > table { border: 3px solid #527bbd; } |
︙ | ︙ | |||
449 450 451 452 453 454 455 | /* * html5 specific * * */ | < < < < < < | 449 450 451 452 453 454 455 456 457 458 459 460 461 462 | /* * html5 specific * * */ table.tableblock { margin-top: 1.0em; margin-bottom: 1.5em; } thead, p.tableblock.header { font-weight: bold; color: #527bbd; |
︙ | ︙ | |||
534 535 536 537 538 539 540 541 542 543 544 545 546 547 | body.manpage div.sectionbody { margin-left: 3em; } @media print { body.manpage div#toc { display: none; } } @media screen { body { max-width: 50em; /* approximately 80 characters wide */ margin-left: 16em; } #toc { | > > | 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 | body.manpage div.sectionbody { margin-left: 3em; } @media print { body.manpage div#toc { display: none; } } @media screen { body { max-width: 50em; /* approximately 80 characters wide */ margin-left: 16em; } #toc { |
︙ | ︙ | |||
1323 1324 1325 1326 1327 1328 1329 | </div> </div> </div> <div class="sect1"> <h2 id="_reference">Reference</h2> <div class="sectionbody"> <div class="sect2"> | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 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 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 | </div> </div> </div> <div class="sect1"> <h2 id="_reference">Reference</h2> <div class="sectionbody"> <div class="sect2"> <h3 id="_config_file_helpers">Config File Helpers</h3> <div class="paragraph"><p>Various helpers for more advanced config files.</p></div> <table class="tableblock frame-topbot grid-all" style=" width:80%; "> <caption class="title">Table 2. Helpers</caption> <col style="width:14%;"> <col style="width:28%;"> <col style="width:28%;"> <col style="width:28%;"> <thead> <tr> <th class="tableblock halign-center valign-top" >Helper </th> <th class="tableblock halign-left valign-top" > Purpose </th> <th class="tableblock halign-left valign-top" > Valid values </th> <th class="tableblock halign-left valign-top" > Comments</th> </tr> </thead> <tbody> <tr> <td class="tableblock halign-center valign-top" ><p class="tableblock">#{scheme (scheme code…)}</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Execute arbitrary scheme code</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Any valid scheme</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Value returned from the call is converted to a string and processed as part of the config file</p></td> </tr> <tr> <td class="tableblock halign-center valign-top" ><p class="tableblock">#{system command}</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Execute program, inserts exit code</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Any valid Unix command</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Discards the output from the program</p></td> </tr> <tr> <td class="tableblock halign-center valign-top" ><p class="tableblock">#{shell command} or #{sh …}</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Execute program, inserts result from stdout</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Any valid Unix command</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Value returned from the call is converted to a string and processed as part of the config file</p></td> </tr> <tr> <td class="tableblock halign-center valign-top" ><p class="tableblock">#{realpath path} or #{rp …}</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Replace with normalized path</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Must be a valid path</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced"></p></td> </tr> <tr> <td class="tableblock halign-center valign-top" ><p class="tableblock">#{getenv VAR} or #{gv VAR}</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Replace with content of env variable</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Must be a valid var</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced"></p></td> </tr> <tr> <td class="tableblock halign-center valign-top" ><p class="tableblock">#{get s v} or #{g s v}</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Replace with variable v from section s</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Variable must be defined before use</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced"></p></td> </tr> <tr> <td class="tableblock halign-center valign-top" ><p class="tableblock">#{rget v}</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced">Replace with variable v from target or default of runconfigs file</p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced"></p></td> <td class="tableblock halign-left valign-top" ><p class="tableblock monospaced"></p></td> </tr> </tbody> </table> </div> <div class="sect2"> <h3 id="_config_file_settings">Config File Settings</h3> <div class="paragraph"><p>Settings in megatest.config</p></div> <div class="sect3"> <h4 id="_disk_space_checks">Disk Space Checks</h4> <div class="paragraph"><p>Some parameters you can put in the [setup] section of megatest.config:</p></div> <div class="listingblock"> <div class="content monospaced"> <pre># minimum space required in a run disk minspace 10000000 |
︙ | ︙ | |||
1446 1447 1448 1449 1450 1451 1452 | </div> <div class="sect2"> <h3 id="_database_settings">Database settings</h3> <table class="tableblock frame-topbot grid-all" style=" width:70%; "> | | | 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 | </div> <div class="sect2"> <h3 id="_database_settings">Database settings</h3> <table class="tableblock frame-topbot grid-all" style=" width:70%; "> <caption class="title">Table 3. Database config settings in [setup] section of megatest.config</caption> <col style="width:14%;"> <col style="width:28%;"> <col style="width:28%;"> <col style="width:28%;"> <thead> <tr> <th class="tableblock halign-center valign-top" >Var </th> |
︙ | ︙ | |||
1822 1823 1824 1825 1826 1827 1828 | <div class="content monospaced"> <pre>[triggers] COMPLETED/ xterm -e bash -s --</pre> </div></div> <div class="admonitionblock"> <table><tr> <td class="icon"> | | | 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 | <div class="content monospaced"> <pre>[triggers] COMPLETED/ xterm -e bash -s --</pre> </div></div> <div class="admonitionblock"> <table><tr> <td class="icon"> <img src="/usr/images/icons/note.png" alt="Note"> </td> <td class="content">There is a trailing space after the --</td> </tr></table> </div> </div> <div class="sect2"> <h3 id="_override_the_toplevel_html_file">Override the Toplevel HTML File</h3> |
︙ | ︙ | |||
1915 1916 1917 1918 1919 1920 1921 | <h2 id="_programming_api">Programming API</h2> <div class="sectionbody"> <div class="paragraph"><p>These routines can be called from the megatest repl.</p></div> <table class="tableblock frame-topbot grid-all" style=" width:70%; "> | | | 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 | <h2 id="_programming_api">Programming API</h2> <div class="sectionbody"> <div class="paragraph"><p>These routines can be called from the megatest repl.</p></div> <table class="tableblock frame-topbot grid-all" style=" width:70%; "> <caption class="title">Table 4. API Keys Related Calls</caption> <col style="width:14%;"> <col style="width:28%;"> <col style="width:28%;"> <col style="width:28%;"> <thead> <tr> <th class="tableblock halign-center valign-top" >API Call </th> |
︙ | ︙ | |||
1967 1968 1969 1970 1971 1972 1973 | </div> </div> </div> <div id="footnotes"><hr></div> <div id="footer"> <div id="footer-text"> Version 1.0<br> | | > | 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 | </div> </div> </div> <div id="footnotes"><hr></div> <div id="footer"> <div id="footer-text"> Version 1.0<br> Last updated 2016-11-27 13:47:38 MST </div> </div> </body> </html> |
Modified docs/manual/reference.txt from [206fb51b8f] to [ab965f2f42].
1 2 3 4 | Reference --------- | > > > > > > > > > > > > > > > > > > > | | > > | 1 2 3 4 5 6 7 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 34 | Reference --------- Config File Helpers ~~~~~~~~~~~~~~~~~~~ Various helpers for more advanced config files. .Helpers [width="80%",cols="^,2m,2m,2m",frame="topbot",options="header"] |====================== |Helper | Purpose | Valid values | Comments | #{scheme (scheme code...)} | Execute arbitrary scheme code | Any valid scheme | Value returned from the call is converted to a string and processed as part of the config file | #{system command} | Execute program, inserts exit code | Any valid Unix command | Discards the output from the program | #{shell command} or #{sh ...} | Execute program, inserts result from stdout | Any valid Unix command | Value returned from the call is converted to a string and processed as part of the config file | #{realpath path} or #{rp ...} | Replace with normalized path | Must be a valid path | | #{getenv VAR} or #{gv VAR} | Replace with content of env variable | Must be a valid var | | #{get s v} or #{g s v} | Replace with variable v from section s | Variable must be defined before use | | #{rget v} | Replace with variable v from target or default of runconfigs file | | | #{mtrah} | Replace with the path to the megatest testsuite area | | |====================== Config File Settings ~~~~~~~~~~~~~~~~~~~~ Settings in megatest.config Disk Space Checks ^^^^^^^^^^^^^^^^^ Some parameters you can put in the [setup] section of megatest.config: ------------------- |
︙ | ︙ |
Modified docs/manual/server.png from [ae7d7ee58e] to [267af6c507].
cannot compute difference between binary files
Modified megatest-version.scm from [a6ad525294] to [0bf6986bb1].
1 2 3 4 5 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.6302) |
Modified megatest.scm from [46d15d3c2a] to [bd5acaa861].
︙ | ︙ | |||
116 117 118 119 120 121 122 | -load-test-data : read test specific data for storage in the test_data table from standard in. Each line is comma delimited with four fields category,variable,value,comment Queries -list-runs patt : list runs matching pattern \"patt\", % is the wildcard -show-keys : show the keys used in this megatest setup | | | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | -load-test-data : read test specific data for storage in the test_data table from standard in. Each line is comma delimited with four fields category,variable,value,comment Queries -list-runs patt : list runs matching pattern \"patt\", % is the wildcard -show-keys : show the keys used in this megatest setup -test-files targpatt : get the most recent test path/file matching targpatt e.g. %/% or '*.log' returns list sorted by age ascending, see examples below -test-paths : get the test paths matching target, runname, item and test patterns. -list-disks : list the disks available for storing runs -list-targets : list the targets in runconfigs.config -list-db-targets : list the target combinations used in the db -show-config : dump the internal representation of the megatest.config file |
︙ | ︙ | |||
788 789 790 791 792 793 794 | (exit)))) ;;====================================================================== ;; Weird special calls that need to run *after* the server has started? ;;====================================================================== (if (args:get-arg "-list-targets") | > | | | | | | | | | | | | | | 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 | (exit)))) ;;====================================================================== ;; Weird special calls that need to run *after* the server has started? ;;====================================================================== (if (args:get-arg "-list-targets") (if (launch:setup) (let ((targets (common:get-runconfig-targets))) (debug:print 1 *default-log-port* "Found "(length targets) " targets") (case (string->symbol (or (args:get-arg "-dumpmode") "alist")) ((alist) (for-each (lambda (x) ;; (print "[" x "]")) (print x)) targets)) ((json) (json-write targets)) (else (debug:print-error 0 *default-log-port* "dump output format " (args:get-arg "-dumpmode") " not supported for -list-targets"))) (set! *didsomething* #t)))) ;; cache the runconfigs in $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME/.runconfig ;; (define (full-runconfigs-read) ;; in the envprocessing branch the below code replaces the further below code ;; (if (eq? *configstatus* 'fulldata) ;; *runconfigdat* |
︙ | ︙ | |||
1016 1017 1018 1019 1020 1021 1022 | ;; (if (args:get-arg "-testpatt") ;; (args:get-arg "-testpatt") ;; "%")) (keys (rmt:get-keys)) ;; (db:get-keys dbstruct)) ;; (runsdat (db:get-runs dbstruct runpatt #f #f '())) ;; (runsdat (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target) ;; #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0)) | | | > | | | | | | | | | | | | | | 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 | ;; (if (args:get-arg "-testpatt") ;; (args:get-arg "-testpatt") ;; "%")) (keys (rmt:get-keys)) ;; (db:get-keys dbstruct)) ;; (runsdat (db:get-runs dbstruct runpatt #f #f '())) ;; (runsdat (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target) ;; #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0)) (runsdat (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0)) (runstmp (db:get-rows runsdat)) (header (db:get-header runsdat)) ;; this is "-since" support. This looks at last mod times of <run-id>.db files ;; and collects those modified since the -since time. (runs runstmp) ;; (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)) (fields-spec (if (args:get-arg "-fields") (extract-fields-constraints (args:get-arg "-fields")) |
︙ | ︙ | |||
1823 1824 1825 1826 1827 1828 1829 | (if (args:get-arg "-cleanup-db") (begin (if (not (launch:setup)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") (exit 1))) | > | | 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 | (if (args:get-arg "-cleanup-db") (begin (if (not (launch:setup)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") (exit 1))) (let ((dbstruct (db:setup *toppath*))) (common:cleanup-db dbstruct)) (set! *didsomething* #t))) (if (args:get-arg "-mark-incompletes") (begin (if (not (launch:setup)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") |
︙ | ︙ |
Modified rmt.scm from [5e992d9837] to [2632e87e3e].
︙ | ︙ | |||
586 587 588 589 590 591 592 | (define (rmt:update-run-event_time run-id) (rmt:send-receive 'update-run-event_time #f (list run-id))) (define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit fields last-runs-update) ;; fields of #f uses default (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields last-runs-update))) (define (rmt:find-and-mark-incomplete run-id ovr-deadtime) | | | | 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 | (define (rmt:update-run-event_time run-id) (rmt:send-receive 'update-run-event_time #f (list run-id))) (define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit fields last-runs-update) ;; fields of #f uses default (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields last-runs-update))) (define (rmt:find-and-mark-incomplete run-id ovr-deadtime) ;; (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime)) (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))) ;; ) (define (rmt:get-main-run-stats run-id) (rmt:send-receive 'get-main-run-stats #f (list run-id))) (define (rmt:get-var varname) (rmt:send-receive 'get-var #f (list varname))) |
︙ | ︙ |
Modified tests.scm from [5514a2a23d] to [63786038c0].
︙ | ︙ | |||
918 919 920 921 922 923 924 | (close-output-port oup))) ;; MUST BE CALLED local! ;; (define (tests:test-get-paths-matching keynames target fnamepatt #!key (res '())) ;; BUG: Move the values derived from args to parameters and push to megatest.scm | | | | | | > > > > > > | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 | (close-output-port oup))) ;; MUST BE CALLED local! ;; (define (tests:test-get-paths-matching keynames target fnamepatt #!key (res '())) ;; BUG: Move the values derived from args to parameters and push to megatest.scm (let* ((testpatt (or (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%")) (statepatt (or (args:get-arg "-state") (args:get-arg ":state") "%")) (statuspatt (or (args:get-arg "-status") (args:get-arg ":status") "%")) (runname (or (args:get-arg "-runname") (args:get-arg ":runname") "%")) (paths-from-db (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname))) (if fnamepatt (apply append (map (lambda (p) (if (directory-exists? p) (let ((glob-query (conc p "/" fnamepatt))) (handle-exceptions exn (with-input-from-pipe (conc "echo " glob-query) read-lines) ;; we aren't going to try too hard. If glob breaks it is likely because someone tried to do */*/*.log or similar (glob glob-query))) '())) paths-from-db)) paths-from-db))) ;;====================================================================== ;; Gather data from test/task specifications |
︙ | ︙ | |||
1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 | (set! res count)) tdb "SELECT count(id) FROM test_rundat;") res)) 0) (define (tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname) (if (and cpuload diskfree) (rmt:general-call 'update-cpuload-diskfree run-id cpuload diskfree test-id)) (if minutes (rmt:general-call 'update-run-duration run-id minutes test-id)) (if (and uname hostname) (rmt:general-call 'update-uname-host run-id uname hostname test-id))) | > | 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 | (set! res count)) tdb "SELECT count(id) FROM test_rundat;") res)) 0) (define (tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname) (rmt:general-call 'update-test-rundat run-id test-id (current-seconds) (or cpuload -1)(or diskfree -1) -1 (or minutes -1)) (if (and cpuload diskfree) (rmt:general-call 'update-cpuload-diskfree run-id cpuload diskfree test-id)) (if minutes (rmt:general-call 'update-run-duration run-id minutes test-id)) (if (and uname hostname) (rmt:general-call 'update-uname-host run-id uname hostname test-id))) |
︙ | ︙ |