Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -7,11 +7,11 @@ ;; 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-case base64 format dot-locking csv-xml) +(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml z3) (require-extension sqlite3 regex posix) (require-extension (srfi 18) extras tcp rpc) (import (prefix sqlite3 sqlite3:)) @@ -118,10 +118,16 @@ ;;====================================================================== (define (common:get-megatest-exe) (if (getenv "MT_MEGATEST") (getenv "MT_MEGATEST") "megatest")) +(define (common:read-encoded-string instr) + (handle-exceptions + exn + (open-input-string (base64:base64-decode instr)) + (read (open-input-string (z3:decode-buffer (base64:base64-decode instr)))))) + ;;====================================================================== ;; S T A T E S A N D S T A T U S E S ;;====================================================================== (define *common:std-states* Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -48,15 +48,15 @@ ;; if handed a string, process it, else look for MT_CMDINFO (define (launch:get-cmdinfo-assoc-list #!key (encoded-cmd #f)) (let ((enccmd (if encoded-cmd encoded-cmd (getenv "MT_CMDINFO")))) (if enccmd - (read (open-input-string (base64:base64-decode enccmd))) + (common:read-encoded-string enccmd) '()))) (define (launch:execute encoded-cmd) - (let* ((cmdinfo (read (open-input-string (z3:decode-buffer (base64:base64-decode encoded-cmd)))))) + (let* ((cmdinfo (common:read-encoded-string encoded-cmd))) (setenv "MT_CMDINFO" encoded-cmd) (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) ;; (test-name sqlitespeed) (runscript runscript.rb) (db-host localhost) (run-id 1)) (let* ((testpath (assoc/default 'testpath cmdinfo)) ;; testpath is the test spec area (top-path (assoc/default 'toppath cmdinfo)) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -591,11 +591,11 @@ (set! *didsomething* #t) (pop-directory))) (if (args:get-arg "-show-cmdinfo") (if (getenv "MT_CMDINFO") - (let ((data (read (open-input-string (z3:decode-buffer (base64:base64-decode (getenv "MT_CMDINFO"))))))) + (let ((data (common:read-encoded-string (getenv "MT_CMDINFO")))) (if (equal? (args:get-arg "-dumpmode") "json") (json-write data) (pp data)) (set! *didsomething* #t)) (debug:print-info 0 "environment variable MT_CMDINFO is not set"))) @@ -859,11 +859,11 @@ ;; Get test paths matching target, runname, and testpatt (if (or (args:get-arg "-test-files")(args:get-arg "-test-paths")) ;; if we are in a test use the MT_CMDINFO data (if (getenv "MT_CMDINFO") (let* ((startingdir (current-directory)) - (cmdinfo (read (open-input-string (z3:decode-buffer (base64:base64-decode (getenv "MT_CMDINFO")))))) + (cmdinfo (commond:read-encoded-string (getenv "MT_CMDINFO"))) (testpath (assoc/default 'testpath cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) @@ -906,11 +906,11 @@ ;; Archive tests matching target, runname, and testpatt (if (args:get-arg "-archive") ;; if we are in a test use the MT_CMDINFO data (if (getenv "MT_CMDINFO") (let* ((startingdir (current-directory)) - (cmdinfo (read (open-input-string (z3:decode-buffer (base64:base64-decode (getenv "MT_CMDINFO")))))) + (cmdinfo (common:read-encoded-string (getenv "MT_CMDINFO"))) (testpath (assoc/default 'testpath cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) @@ -984,11 +984,11 @@ (define (megatest:step step state status logfile msg) (if (not (getenv "MT_CMDINFO")) (begin (debug:print 0 "ERROR: MT_CMDINFO env var not set, -step must be called *inside* a megatest invoked environment!") (exit 5)) - (let* ((cmdinfo (read (open-input-string (z3:decode-buffer (base64:base64-decode (getenv "MT_CMDINFO")))))) + (let* ((cmdinfo (common:read-encoded-string (getenv "MT_CMDINFO"))) (testpath (assoc/default 'testpath cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) @@ -1030,11 +1030,11 @@ (if (not (getenv "MT_CMDINFO")) (begin (debug:print 0 "ERROR: MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!") (exit 5)) (let* ((startingdir (current-directory)) - (cmdinfo (read (open-input-string (z3:decode-buffer (base64:base64-decode (getenv "MT_CMDINFO")))))) + (cmdinfo (common:read-encoded-string (getenv "MT_CMDINFO"))) (testpath (assoc/default 'testpath cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) Index: tests/fullrun/megatest.config ================================================================== --- tests/fullrun/megatest.config +++ tests/fullrun/megatest.config @@ -80,11 +80,13 @@ # override the html viewer launch command # # htmlviewercmd firefox -new-window htmlviewercmd konqueror -# -runtests automatically cleans these up on starting up a run for fresh +# -runtests automatically deletes the records for tests with the listed states on starting up a run allowing them to re-run +# (nb// this is in addition to NOT_STARTED which is automatically re-run) +# allow-auto-rerun INCOMPLETE ZERO_ITEMS # could add: STUCK STUCK/DEAD UNKNOWN KILLED KILLREQ PREQ_DISCARD [validvalues] state start end 0 1 - 2