Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -89,10 +89,14 @@ chmod a+x $@ $(DEPLOYHELPERS) : utils/mt_* $(INSTALL) $< $@ chmod a+X $@ + +$(PREFIX)/bin/mt_xterm : utils/mt_xterm + $(INSTALL) $< $@ + chmod a+x $@ $(PREFIX)/bin/nbfake : utils/nbfake $(INSTALL) $< $@ chmod a+x $@ @@ -117,11 +121,12 @@ $(PREFIX)/bin/dboard : dboard $(FILES) $(INSTALL) dboard $(PREFIX)/bin/dboard utils/mk_wrapper $(PREFIX) dboard > $(PREFIX)/bin/dashboard chmod a+x $(PREFIX)/bin/dashboard -install : bin $(PREFIX)/bin/mtest $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake $(PREFIX)/bin/nbfind $(PREFIX)/bin/newdboard $(PREFIX)/bin/refdb +install : bin $(PREFIX)/bin/mtest $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \ + $(PREFIX)/bin/nbfind $(PREFIX)/bin/newdboard $(PREFIX)/bin/refdb $(PREFIX)/bin/mt_xterm deploytarg/apropos.so : Makefile for i in apropos base64 canvas-draw csv-xml directory-utils dot-locking extras fmt format hostinfo http-client intarweb json md5 message-digest posix posix-extras readline regex regex-case s11n spiffy spiffy-request-vars sqlite3 srfi-1 srfi-18 srfi-69 tcp test uri-common check-errors synch matchable sql-null tcp-server rpc blob-utils string-utils variable-item defstruct uri-generic sendfile opensll openssl lookup-table list-utils stack; do \ chicken-install -prefix deploytarg -deploy $$i;done Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -250,10 +250,40 @@ (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR"))) (iup:attribute-set! btn "BGCOLOR" newcolor)))) btns))) btns)))))) +(define (dashboard-tests:run-html-viewer lfilename) + (let ((htmlviewercmd (configf:lookup *configdat* "setup" "htmlviewercmd"))) + (if htmlviewercmd + (system (conc "(" htmlviewercmd " " lfilename " ) &")) + (iup:send-url lfilename)))) + +(define (dashboard-tests:step-run-control test-id stepname teststeps) + (iup:dialog ;; #:close_cb (lambda (a)(exit)) ; #:expand "YES" + #:title stepname + (iup:vbox ; #:expand "YES" + (iup:label (conc "Step: " stepname "\nNB// These buttons only run the test step\nfor the purpose of debugging.\nNot all database updates are done.")) + (iup:button "Re-run" + #:expand "HORIZONTAL" + #:action (lambda (obj) + (print "Rerun " stepname))) + (iup:button "Re-run and continue" + #:expand "HORIZONTAL" + #:action (lambda (obj) + (let ((inprocess #f)) + (for-each + (lambda (stepn) + (let ((curr-step-name (vector-ref stepn 0))) + (if (equal? curr-step-name stepname)(set! inprocess #t)) + (if inprocess (print "Continue " curr-step-name)))) + teststeps)))) + ;; (iup:button "Refresh test data" + ;; #:expand "HORIZONTAL" + ;; #:action (lambda (obj) + ;; (print "Refresh test data " stepname)) + ))) ;;====================================================================== ;; ;;====================================================================== (define (examine-test test-id) ;; run-id run-key origtest) @@ -294,36 +324,36 @@ "/")) (item-path (db:test-get-item-path testdat)) (viewlog (lambda (x) (if (file-exists? logfile) ;(system (conc "firefox " logfile "&")) - (iup:send-url logfile) + (dashboard-tests:run-html-viewer logfile) (message-window (conc "File " logfile " not found"))))) - (view-a-log (lambda (lfile) + (view-a-log (lambda (lfile) (let ((lfilename (conc rundir "/" lfile))) ;; (print "lfilename: " lfilename) (if (file-exists? lfilename) ;(system (conc "firefox " logfile "&")) - (iup:send-url lfilename) + (dashboard-tests:run-html-viewer lfilename) (message-window (conc "File " lfilename " not found")))))) (xterm (lambda (x) (if (directory-exists? rundir) (let ((shell (if (get-environment-variable "SHELL") (conc "-e " (get-environment-variable "SHELL")) ""))) (system (conc "cd " rundir - ";xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&"))) + ";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&"))) (message-window (conc "Directory " rundir " not found"))))) (widgets (make-hash-table)) (refreshdat (lambda () (let* ((curr-mod-time (max (file-modification-time db-path) (if (file-exists? testdat-path) (file-modification-time testdat-path) (begin (set! testdat-path (conc rundir "/testdat.db")) 0)))) - (need-update (or (and (> curr-mod-time db-mod-time) + (need-update (or (and (>= curr-mod-time db-mod-time) (> (current-milliseconds)(+ last-update 250))) ;; every half seconds if db touched (> (current-milliseconds)(+ last-update 10000)) ;; force update even 10 seconds request-update)) (newtestdat (if need-update (handle-exceptions @@ -336,11 +366,13 @@ (set! teststeps (db:get-compressed-steps test-id work-area: rundir)) (set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat))) (set! rundir (db:test-get-rundir testdat)) (set! testfullname (db:test-get-fullname testdat)) ;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n ")) - (set! db-mod-time curr-mod-time) + (if (eq? curr-mod-time db-mod-time) ;; do only once if same + (set! db-mod-time (+ curr-mod-time 1)) + (set! db-mod-time curr-mod-time)) (set! last-update (current-milliseconds)) (set! request-update #f) ;; met the need ... ) (need-update ;; if this was true and yet there is no data .... (db:test-set-testname! testdat "DEAD OR DELETED TEST"))) @@ -451,13 +483,17 @@ #:numlin-visible 5 #:click-cb (lambda (obj lin col status) ;; (if (equal? col 6) (let* ((mtrx-rc (conc lin ":" 6)) (fname (iup:attribute obj mtrx-rc))) ;; col)))) - (view-a-log fname))) - ;; (print "obj: " obj " mtrx-rc: " mtrx-rc " fname: " fname " lin: " lin " col: " col " status: " status))) - ))) + (if (eq? col 6) + (view-a-log fname) + (iup:show + (dashboard-tests:step-run-control + test-id + (iup:attribute obj (conc lin ":" 1)) + teststeps)))))))) ;; (let loop ((count 0)) ;; (iup:attribute-set! steps-matrix "FITTOTEXT" (conc "L" count)) ;; (if (< count 30) ;; (loop (+ count 1)))) (iup:attribute-set! steps-matrix "0:1" "Step Name") Index: tests/fullrun/megatest.config ================================================================== --- tests/fullrun/megatest.config +++ tests/fullrun/megatest.config @@ -44,17 +44,32 @@ throttle 0.2 # Max retries allows megatest to re-check that a tests status has changed # as tests can have transient FAIL status occasionally maxretries 20 +# Setup continued. +[setup] + +# override the logview command +# +logviewer (%MTCMD%) 2> /dev/null > /dev/null + +# override the html viewer launch command +# +# htmlviewercmd firefox -new-window +htmlviewercmd konqueror + [validvalues] state start end 0 1 - 2 status pass fail n/a 0 1 running - 2 # These are set before all tests, override them # in the testconfig [pre-launch-env-overrides] section [env-override] +# MT_XTERM_CMD overrides the terminal command +# MT_XTERM_CMD xterm -bg lightgreen -fg black + SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs TESTVAR [system echo $PWD] DEADVAR [system ls] VARWITHDOLLAR $HOME/.zshrc WACKYVAR #{system ls > /dev/null} ADDED utils/mt_xterm Index: utils/mt_xterm ================================================================== --- /dev/null +++ utils/mt_xterm @@ -0,0 +1,12 @@ +#!/bin/bash + +if [ -e megatest.sh ];then + source megatest.sh +fi + +if [ x"$MT_XTERM_CMD" == "x" ];then + exec xterm "$@" +else + exec $MT_XTERM_CMD +fi +