Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -9,11 +9,11 @@ db.scm keys.scm margs.scm megatest-version.scm \ process.scm runs.scm tasks.scm tests.scm genexample.scm \ http-transport.scm filedb.scm tdb.scm \ client.scm daemon.scm mt.scm \ ezsteps.scm lock-queue.scm sdb.scm \ - rmt.scm api.scm \ + rmt.scm api.scm subrun.scm \ portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm # module source files MSRCFILES = ftail.scm @@ -91,10 +91,11 @@ runs.o \ server.o \ tasks.o \ tdb.o \ tests.o \ + subrun.o \ tcmt : $(TCMTOBJS) tcmt.scm csc $(CSCOPTS) $(TCMTOBJS) tcmt.scm -o tcmt Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -13,15 +13,17 @@ format dot-locking csv-xml z3 ;; sql-de-lite hostinfo md5 message-digest typed-records directory-utils stack matchable regex posix (srfi 18) extras ;; tcp (prefix nanomsg nmsg:) (prefix sqlite3 sqlite3:) - pkts) + pkts + ) (declare (unit common)) (include "common_records.scm") + ;; (require-library margs) ;; (include "margs.scm") ;; (define old-exit exit) @@ -1779,10 +1781,30 @@ "# export " "export ") key "=" delim (mungeval val) delim))) envvars))))) + +(define (common:get-param-mapping #!key (flavor #f)) + "returns alist mapping string keys in testconfig/subrun to megatest command line switches; if flavor is switch-symbol, maps tcmt symbolic switches to megatest switches" + (let ((default '(("tag-expr" . "-tagexpr") + ("mode-patt" . "-modepatt") + ("run-name" . "-runname") + ("contour" . "-contour") + ("mode-patt" . "-mode-patt") + ("target" . "-target") + ("test-patt" . "-testpatt") + ("msg" . "-m") + ("log" . "-log") + ("start-dir" . "-start-dir") + ("new" . "-set-state-status")))) + (if (eq? flavor 'switch-symbol) + (map (lambda (x) + (cons (string->symbol (conc "-" (car x))) (cdr x))) + default) + default))) + ;; set some env vars from an alist, return an alist with original values ;; (("VAR" "value") ...) ;; a value of #f means "unset this var" ;; (define (alist->env-vars lst) @@ -1797,10 +1819,11 @@ (safe-setenv var (->string val)) (unsetenv var)))) lst) res) '())) + ;; clear vars matching pattern, run proc, set vars back ;; if proc is a string run that string as a command with ;; system. ;; @@ -1823,10 +1846,11 @@ (hash-table-for-each vars (lambda (var val) (setenv var val))) vars)) + (define (common:run-a-command cmd #!key (with-vars #f)) (let* ((pre-cmd (dtests:get-pre-command)) (post-cmd (dtests:get-post-command)) (fullcmd (if (or pre-cmd post-cmd) @@ -2605,5 +2629,11 @@ restore-thunk)) delta-env-alist)))) (let ((rv (thunk))) (for-each (lambda (x) (x)) restore-thunks) ;; restore env to original state rv))) + +(define (common:send-thunk-to-background-thread thunk #!key (name #f)) + ;;(BB> "launched thread " name) + (if name + (thread-start! (make-thread thunk name)) + (thread-start! (make-thread thunk)))) Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -249,11 +249,11 @@ (subrun-tconf-file (conc test-run-dir "/testconfig.subrun")) (subrun-tconf (if (file-exists? subrun-tconf-file) (configf:read-alist subrun-tconf-file) (make-hash-table))) (subarea (or (configf:lookup testconfig "setup" "submegatest") - (configf:lookup subrun-tconf "subrun" "runarea"))) + (configf:lookup subrun-tconf "subrun" "run-area"))) (area-exists (and subarea (common:file-exists? subarea)))) ;; (debug:print-info 0 *default-log-port* "Megatest subarea=" subarea ", area-exists=" area-exists) (if subarea (iup:frame #:title "Megatest Run Info" ; #:expand "YES" Index: docs/api.html ================================================================== --- docs/api.html +++ docs/api.html @@ -1015,10 +1015,10 @@