Overview
Comment: | Extended calls to triggers to all situations where state/status are being directly set. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
ff986ee4551363a15960af652803a613 |
User & Date: | matt on 2015-07-02 00:03:56 |
Other Links: | branch diff | manifest | tags |
Context
2015-07-05
| ||
16:58 | Fixed item based waiting. check-in: e2d83122be user: matt tags: v1.60, v1.6018 | |
2015-07-02
| ||
00:03 | Extended calls to triggers to all situations where state/status are being directly set. check-in: ff986ee455 user: matt tags: v1.60 | |
2015-07-01
| ||
11:30 | Updated docs check-in: 3d83362e7e user: mrwellan tags: v1.60 | |
Changes
Modified db.scm from [1f80fff6ba] to [ed28b97a1a].
︙ | ︙ | |||
2256 2257 2258 2259 2260 2261 2262 | (if currstatus (conc "status='" currstatus "' AND ") "") " run_id=? AND testname LIKE ?;"))) (db:with-db dbstruct run-id #t (lambda (db) | | > > | 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 | (if currstatus (conc "status='" currstatus "' AND ") "") " run_id=? AND testname LIKE ?;"))) (db:with-db dbstruct run-id #t (lambda (db) (sqlite3:execute db qry newstate newstatus run-id testname) (mt:process-triggers run-id test-id newstate newstatus) )))) testnames)) ;; 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) (db:with-db |
︙ | ︙ | |||
2827 2828 2829 2830 2831 2832 2833 | (define (db:test-set-status-state dbstruct run-id test-id status state msg) (let ((dbdat (db:get-db dbstruct run-id))) (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) (db:general-call dbdat 'set-test-start-time (list test-id))) (if msg (db:general-call dbdat 'state-status-msg (list state status msg test-id)) | | > | 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 | (define (db:test-set-status-state dbstruct run-id test-id status state msg) (let ((dbdat (db:get-db dbstruct run-id))) (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) (db:general-call dbdat 'set-test-start-time (list test-id))) (if msg (db:general-call dbdat 'state-status-msg (list state status msg test-id)) (db:general-call dbdat 'state-status (list state status test-id))) (mt:process-triggers run-id test-id state status))) ;; call with state = #f to roll up with out accounting for state/status of this item ;; (define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status) (if (not (equal? item-path "")) (let ((dbdat (db:get-db dbstruct run-id))) ;; (db (db:dbdat-get-db dbdat))) |
︙ | ︙ |
Modified mt.scm from [a598f8fbca] to [26df5f3021].
1 2 3 4 5 6 7 8 9 10 | ;; Copyright 2006-2013, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | ;; Copyright 2006-2013, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils call-with-environment-variables) (import (prefix sqlite3 sqlite3:)) (declare (unit mt)) (declare (uses db)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) |
︙ | ︙ | |||
138 139 140 141 142 143 144 | (test-name (db:test-get-testname test-dat)) (tconfig #f) (state (if newstate newstate (db:test-get-state test-dat))) (status (if newstatus newstatus (db:test-get-status test-dat)))) (if (and test-rundir ;; #f means no dir set yet (file-exists? test-rundir) (directory? test-rundir)) | > > > > | | | < | | | | | | | | | | | | | | > > | 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 | (test-name (db:test-get-testname test-dat)) (tconfig #f) (state (if newstate newstate (db:test-get-state test-dat))) (status (if newstatus newstatus (db:test-get-status test-dat)))) (if (and test-rundir ;; #f means no dir set yet (file-exists? test-rundir) (directory? test-rundir)) (call-with-environment-variables (list (cons "MT_TEST_NAME" test-name) (cons "MT_TEST_RUN_DIR" test-rundir) (cons "MT_ITEMPATH" (db:test-get-item-path test-dat))) (lambda () (push-directory test-rundir) (set! tconfig (mt:lazy-read-test-config test-name)) (for-each (lambda (trigger) (let ((cmd (configf:lookup tconfig "triggers" trigger)) (logf (conc test-rundir "/last-trigger.log"))) (if cmd ;; Putting the commandline into ( )'s means no control over the shell. ;; stdout and stderr will be caught in the NBFAKE or mt_launch.log files ;; or equivalent. No need to do this. Just run it? (let ((fullcmd (conc cmd " " test-id " " test-rundir " " trigger "&"))) (debug:print-info 0 "TRIGGERED on " trigger ", running command " fullcmd) (process-run fullcmd))))) (list (conc state "/" status) (conc state "/") (conc "/" status))) (pop-directory)) )))) ;;====================================================================== ;; 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 (define (mt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment) |
︙ | ︙ |