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