Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -29,11 +29,11 @@
 (define *toppath*    #f)
 (define *already-seen-runconfig-info* #f)
 (define *waiting-queue* (make-hash-table))
 (define *globalexitstatus* 0) ;; attempt to work around possible thread issues
 (define *passnum*     0) ;; when running track calls to run-tests or similar
-
+(define *verbosity*   1)
 
 (define-inline (get-with-default val default)
   (let ((val (args:get-arg val)))
     (if val val default)))
 
@@ -42,10 +42,14 @@
     (if res (cadr res)(if (null? default) #f (car default)))))
 
 ;;======================================================================
 ;; Misc utils
 ;;======================================================================
+
+(define-inline (debug:print n . params)
+  (if (<= n *verbosity*)
+      (apply print params)))
 
 (define (get-df path)
   (let* ((df-results (cmd-run->list (conc "df " path)))
 	 (space-rx   (regexp "([0-9]+)\\s+([0-9]+)%"))
 	 (freespc    #f))

Index: configf.scm
==================================================================
--- configf.scm
+++ configf.scm
@@ -58,11 +58,11 @@
 						    (val   (let* ((cmdres  (cmd-run->list cmd))
 								  (status  (cadr cmdres))
 								  (res     (car  cmdres)))
 							     (if (not (eq? status 0))
 								 (begin
-								   (print "ERROR: problem with " inl ", return code not 0")
+								   (debug:print 0 "ERROR: problem with " inl ", return code " status)
 								   (exit 1)))
 							     (if (null? res)
 								 ""
 								 (string-intersperse res " ")))))
 						(hash-table-set! res curr-section-name 
@@ -72,11 +72,11 @@
 	       (key-val-pr ( x key val      ) (let ((alist (hash-table-ref/default res curr-section-name '())))
 						(hash-table-set! res curr-section-name 
 								 (config:assoc-safe-add alist key val))
 								 ;; (append alist (list (list key val))))
 						(loop (read-line inp) curr-section-name)))
-	       (else (print "ERROR: problem parsing " path ",\n   \"" inl "\"")
+	       (else (debug:print 0 "ERROR: problem parsing " path ",\n   \"" inl "\"")
 		     (loop (read-line inp) curr-section-name))))))))
   
 (define (find-and-read-config fname)
   (let* ((curr-dir   (current-directory))
          (configinfo (find-config fname))

Index: dashboard-tests.scm
==================================================================
--- dashboard-tests.scm
+++ dashboard-tests.scm
@@ -203,11 +203,12 @@
 	 (logfile       "/this/dir/better/not/exist")
 	 (rundir        logfile)
 	 (testfullname  (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
 	 (viewlog    (lambda (x)
 		       (if (file-exists? logfile)
-			   (system (conc "firefox " logfile "&"))
+			   ;(system (conc "firefox " logfile "&"))
+			   (iup:send-url logfile)
 			   (message-window (conc "File " logfile " not found")))))
 	 (xterm      (lambda (x)
 		       (if (directory-exists? rundir)
 			   (let ((shell (if (get-environment-variable "SHELL") 
 					    (conc "-e " (get-environment-variable "SHELL"))

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -17,10 +17,11 @@
 
 (use sqlite3 srfi-1 posix regex regex-case srfi-69)
 
 (import (prefix sqlite3 sqlite3:))
 
+(include "common.scm")
 (include "margs.scm")
 (include "keys.scm")
 (include "items.scm")
 (include "db.scm")
 (include "configf.scm")
@@ -48,12 +49,15 @@
 (define remargs (args:get-args 
 		 (argv)
 		 (list  "-rows"
 			"-run"
 			"-test"
+			"-debug"
 			) 
 		 (list  "-h"
+			"-v"
+			"-q"
 		       )
 		 args:arg-hash
 		 0))
 
 (if (args:get-arg "-h")
@@ -75,20 +79,76 @@
 (define dbkeys   (map (lambda (x)(vector-ref x 0))
 		      (append *keys* (list (vector "runname" "blah")))))
 (define *header*       #f)
 (define *allruns*     '())
 (define *buttondat*    (make-hash-table)) ;; <run-id color text test run-key>
-(define *alltestnames* (make-hash-table)) ;; build a minimalized list of test names
 (define *alltestnamelst* '())
 (define *searchpatts*  (make-hash-table))
 (define *num-runs*      10)
 (define *num-tests*     15)
 (define *start-run-offset*  0)
 (define *start-test-offset* 0)
 (define *examine-test-dat* (make-hash-table))
 (define *exit-started* #f)
 
+(define *verbosity* (cond
+		     ((args:get-arg "-debug")(string->number (args:get-arg "-debug")))
+		     ((args:get-arg "-v")    2)
+		     ((args:get-arg "-q")    0)
+		     (else                   1)))
+
+(define uidat #f)
+;; (megatest-dashboard)
+
+;(define img1 (iup:image/palette 16 16 (u8vector->blob (u8vector
+;				   1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 
+;				   1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 
+;				   1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 
+;				   1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 
+;				   1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 
+;				   1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 
+;				   1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 
+;				   1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 
+;				   2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 
+;				   2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 
+;				   2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 
+;				   2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 
+;				   2 2 2 0 2 0 2 0 2 2 0 2 2 2 0 0 
+;				   2 2 2 0 2 0 0 2 0 0 2 0 2 0 2 2 
+;				   2 2 2 0 2 0 2 2 0 2 2 0 2 2 2 2 
+;				   2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0 
+;				   2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 1))))
+;
+;(define img2 (iup:image/palette 16 16 (u8vector->blob (u8vector
+;				   2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 
+;				   2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 
+;				   2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 
+;				   1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 
+;				   1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 
+;				   1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 
+;				   1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 
+;				   1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 
+;				   2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 
+;				   2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 
+;				   2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 
+;				   2 2 2 0 2 2 2 2 2 2 2 2 2 2 2 2 
+;				   2 2 2 0 2 0 2 0 2 2 0 2 2 2 0 0 
+;				   2 2 2 0 2 0 0 2 0 0 2 0 2 0 2 2 
+;				   2 2 2 0 2 0 2 2 0 2 2 0 2 2 2 2 
+;				   2 2 2 0 2 0 2 2 0 2 2 0 2 2 0 0 
+;				   2 2 2 0 2 0 2 2 0 2 2 0 2 0 2 1))))
+;
+;(iup:handle-name-set! img1 "img1")
+;(iup:attribute-set! img1 "0" "0 0 0")
+;(iup:attribute-set! img1 "1" "BGCOLOR")
+;(iup:attribute-set! img1 "2" "255 0 0")
+;
+;(iup:handle-name-set! img2 "img2")
+;(iup:attribute-set! img2 "0" "0 0 0")
+;(iup:attribute-set! img2 "1" "BGCOLOR")
+;(iup:attribute-set! img2 "2" "255 0 0")
+
 (define (message-window msg)
   (iup:show
    (iup:dialog
     (iup:vbox 
      (iup:label msg #:margin "40x40")))))
@@ -130,10 +190,55 @@
 	      runs)
     (set! *header*  header)
     (set! *allruns* result)
     maxtests))
 
+(define *collapsed* (make-hash-table))
+; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj)
+
+(define (toggle-hide lnum) ; fulltestname)
+  (let* ((btn (vector-ref (vector-ref uidat 0) lnum))
+	 (fulltestname (iup:attribute btn "TITLE"))
+	 (parts        (string-split fulltestname "("))
+	 (basetestname (if (null? parts) "" (car parts))))
+    ;(print "Toggling " basetestname " currently " (hash-table-ref/default *collapsed* basetestname #f))
+    (if (hash-table-ref/default *collapsed* basetestname #f)
+	(begin
+	  ;(iup:attribute-set! btn "FGCOLOR" "0 0 0")
+	  (hash-table-delete! *collapsed* basetestname))
+	(begin
+	  ;(iup:attribute-set! btn "FGCOLOR" "0 192 192")
+	  (hash-table-set! *collapsed* basetestname #t)))))
+  
+(define blank-line-rx (regexp "^\\s*$"))
+
+(define (collapse-rows inlst)
+  (let ((newlst (filter (lambda (x)
+			  (let* ((tparts    (string-split x "("))
+				 (basetname (if (null? tparts) x (car tparts))))
+					;(print "x " x " tparts: " tparts " basetname: " basetname)
+			    (cond
+			     ((string-match blank-line-rx x) #f)
+			     ((equal? x basetname) #t)
+			     ((hash-table-ref/default *collapsed* basetname #f) 
+					;(print "Removing " basetname " from items")
+			      #f)
+			     (else #t))))
+			inlst)))
+    ;; special sort to push the test(item) to after test
+    (sort newlst (lambda (a b)
+		   (let* ((partsa (string-split a "("))
+			  (partsb (string-split b "("))
+			  (lena   (length partsa))
+			  (lenb   (length partsb)))
+		     (if (or (and (eq? lena 1)(> lenb 1))
+			     (and (eq? lenb 1)(> lena 1)))
+			 (if (equal? (car partsa)(car partsb)) ;; same test
+			     (> lenb lena)
+			     #t)
+			 #t))))))
+			     
 (define (update-labels uidat)
   (let* ((rown    0)
 	 (lftcol  (vector-ref uidat 0))
 	 (numcols (vector-length lftcol))
 	 (maxn    (- numcols 1))
@@ -141,19 +246,21 @@
     (for-each (lambda (name)
 		(if (<= rown maxn)
 		    (let ((labl (vector-ref lftcol rown)))
 		      (vector-set! allvals rown name)))
 		(set! rown (+ 1 rown)))
-	      (if (> (length *alltestnamelst*) *start-test-offset*)
-		  (drop *alltestnamelst* *start-test-offset*)
-		  '()))
+	      *alltestnamelst*)
+	;      (if (> (length *alltestnamelst*) *start-test-offset*)
+	;	  (drop *alltestnamelst* *start-test-offset*)
+	;	  '()))
     (let loop ((i 0))
       (let* ((lbl    (vector-ref lftcol i))
 	     (oldval (iup:attribute lbl "TITLE"))
 	     (newval (vector-ref allvals i)))
 	(if (not (equal? oldval newval))
 	    (iup:attribute-set! lbl "TITLE" newval))
+	(iup:attribute-set! lbl "FGCOLOR" (if (hash-table-ref/default *collapsed* newval #f) "0 112 112" "0 0 0"))
 	(if (< i maxn)
 	    (loop (+ i 1)))))))
 
 (define (get-color-for-state-status state status)
   (case (string->symbol state)
@@ -179,55 +286,44 @@
 			  (pad-list *allruns* numruns)))
 	 (lftcol      (vector-ref uidat 0))
 	 (tableheader (vector-ref uidat 1))
 	 (table       (vector-ref uidat 2))
 	 (coln        0))
-    (update-labels uidat)
-    (for-each 
-     (lambda (popup)
-       (let* ((test-id  (car popup))
-	      (widgets  (hash-table-ref *examine-test-dat* popup))
-	      (stepslbl (hash-table-ref/default widgets "Test Steps" #f)))
-	 (if stepslbl
-	     (let* ((fmtstr  "~15a~8a~8a~20a")
-		    (newtxt  (string-intersperse 
-			      (append
-			       (list 
-				(format #f fmtstr "Stepname" "State" "Status" "Event Time")
-				(format #f fmtstr "========" "=====" "======" "=========="))
-			       (map (lambda (x)
-				      ;; take advantage of the \n on time->string
-				      (format #f fmtstr
-					      (db:step-get-stepname x)
-					      (db:step-get-state    x)
-					      (db:step-get-status   x)
-					      (time->string 
-					       (seconds->local-time 
-						(db:step-get-event_time x)))))
-				    (db-get-test-steps-for-run *db* test-id)))
-			     "\n")))
-	       (iup:attribute-set! stepslbl "TITLE" newtxt)))))
-     (hash-table-keys *examine-test-dat*))
     (set! *alltestnamelst* '())
+    ;; create a concise list of test names
+    (for-each (lambda (rundat)
+		(if (vector? rundat)
+		    (let* ((testdat   (vector-ref rundat 1))
+			   (testnames (map test:test-get-fullname testdat)))
+		      (for-each (lambda (testname)
+				  (if (not (member testname *alltestnamelst*))
+				      (begin
+					(set! *alltestnamelst* (append *alltestnamelst* (list testname))))))
+				testnames))))
+	      runs)
+
+    (set! *alltestnamelst* (collapse-rows *alltestnamelst*)) ;;; argh. please clean up this sillyness
+    (set! *alltestnamelst* (let ((xl (if (> (length *alltestnamelst*) *start-test-offset*)
+					 (drop *alltestnamelst* *start-test-offset*)
+					 '())))
+			     (append xl (make-list (- *num-tests* (length xl)) ""))))
+    (update-labels uidat)
     (for-each
      (lambda (rundat)
        (if (not rundat) ;; handle padded runs
 	   ;;           ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
 	   (set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") *keys*))));; 3)))
        (let* ((run      (vector-ref rundat 0))
 	      (testsdat (vector-ref rundat 1))
 	      (key-val-dat (vector-ref rundat 2))
 	      (run-id   (db:get-value-by-header run *header* "id"))
-	      (testnames (delete-duplicates (append *alltestnamelst* 
-						    (map test:test-get-fullname testsdat)))) ;; (take (pad-list testsdat numtests) numtests))
 	      (key-vals (append key-val-dat
 				(list (let ((x (db:get-value-by-header run *header* "runname")))
 					(if x x "")))))
 	      (run-key  (string-intersperse key-vals "\n")))
-	 ;; (run-ht  (hash-table-ref/default alldat run-key #f)))
+
 	 ;; fill in the run header key values
-	 (set! *alltestnamelst* testnames)
 	 (let ((rown      0)
 	       (headercol (vector-ref tableheader coln)))
 	   (for-each (lambda (kval)
 		       (let* ((labl      (vector-ref headercol rown)))
 			 (if (not (equal? kval (iup:attribute labl "TITLE")))
@@ -246,11 +342,10 @@
 							(lambda (x)(equal? (test:test-get-fullname x) testname))
 							testsdat)))
 					 (if (null? matching)
 					     (vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "")
 					     (car matching))))
-			   ;; (test       (if real-test real-test
 			   (testname   (db:test-get-testname  test))
 			   (itempath   (db:test-get-item-path test))
 			   (testfullname (test:test-get-fullname test))
 			   (teststatus (db:test-get-status   test))
 			   (teststate  (db:test-get-state    test))
@@ -259,32 +354,21 @@
 			   (buttontxt  (if (equal? teststate "COMPLETED") teststatus teststate))
 			   (button     (vector-ref columndat rown))
 			   (color      (get-color-for-state-status teststate teststatus))
 			   (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
 			   (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
-		;;       (if (and (equal? teststate "RUNNING")
-		;; 	       (> (- (current-seconds) (+ teststart runtime)) 100)) ;; if test has been dead for more than 100 seconds, call it dead
-			  
 		      (if (not (equal? curr-color color))
 			  (iup:attribute-set! button "BGCOLOR" color))
 		      (if (not (equal? curr-title buttontxt))
 			  (iup:attribute-set! button "TITLE"   buttontxt))
 		      (vector-set! buttondat 0 run-id)
 		      (vector-set! buttondat 1 color)
 		      (vector-set! buttondat 2 buttontxt)
 		      (vector-set! buttondat 3 test)
-		      (vector-set! buttondat 4 run-key)
-		      (if (not (hash-table-ref/default *alltestnames* testfullname #f))
-			  (begin
-			    (hash-table-set! *alltestnames* testfullname #t)
-			    (set! *alltestnamelst* (append *alltestnamelst* (list testfullname))))))
-		    )
+		      (vector-set! buttondat 4 run-key)))
 		(set! rown (+ rown 1))))
-	    (let ((xl (if (> (length testnames) *start-test-offset*)
-			  (drop testnames *start-test-offset*)
-			  '()))) ;; testnames)))
-	      (append xl (make-list (- *num-tests* (length xl)) "")))))
+	    *alltestnamelst*))
 	 (set! coln (+ coln 1))))
      runs)))
 
 (define (mkstr . x)
   (string-intersperse (map conc x) ","))
@@ -339,11 +423,18 @@
       (cond
        ((>= testnum ntests)
 	;; now lftlst will be an hbox with the test keys and the test name labels
 	(set! lftlst (append lftlst (list (apply iup:vbox (reverse res))))))
        (else
-	(let ((labl  (iup:button "" #:flat "YES" #:size "100x15" #:fontsize "10")))
+	(let ((labl  (iup:button "" 
+				 #:flat "YES" 
+				 ; #:image img1
+				 ; #:impress img2
+				 #:size "100x15"
+				 #:fontsize "10"
+				 #:action (lambda (obj)
+					      (toggle-hide testnum))))) ;; (iup:attribute obj "TITLE"))))
 	  (vector-set! lftcol testnum labl)
 	  (loop (+ testnum 1)(cons labl res))))))
     ;; 
     (let loop ((runnum  0)
 	       (keynum  0)
@@ -354,12 +445,11 @@
        ((>= keynum nkeys) 
 	(vector-set! header runnum keyvec)
 	(set! hdrlst (cons (apply iup:vbox (reverse res)) hdrlst))
 	(loop (+ runnum 1) 0 (make-vector nkeys) '()))
        (else
-	(let ((labl  (iup:label "" #:size "60x15" #:fontsize "10" ;; #:expand "HORIZONTAL"
-				)))
+	(let ((labl  (iup:label "" #:size "60x15" #:fontsize "10"))) ;; #:expand "HORIZONTAL"
 	  (vector-set! keyvec keynum labl)
 	  (loop runnum (+ keynum 1) keyvec (cons labl res))))))
     ;; By here the hdrlst contains a list of vboxes containing nkeys labels
     (let loop ((runnum  0)
 	       (testnum 0)
@@ -380,11 +470,11 @@
 				       #:action (lambda (x)
 						  (let* ((toolpath (car (argv)))
 							 (buttndat (hash-table-ref *buttondat* button-key))
 							 (test-id  (db:test-get-id (vector-ref buttndat 3)))
 							 (cmd  (conc toolpath " -test " test-id "&")))
-						    (print "Launching " cmd)
+						    ;(print "Launching " cmd)
 						    (system cmd))))))
 	  (hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f)) 
 	  (vector-set! testvec testnum butn)
 	  (loop runnum (+ testnum 1) testvec (cons butn res))))))
     ;; now assemble the hdrlst and bdylst and kick off the dialog
@@ -408,13 +498,10 @@
         (set! *num-tests* (string->number (or (args:get-arg "-rows")
 					      (get-environment-variable "DASHBOARDROWS"))))
 	(update-rundat "%" *num-runs* "%" "%"))
     (set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20)))
 
-(define uidat #f)
-;; (megatest-dashboard)
-
 (define (run-update mtx1)
   (let loop ((i 0))
     (thread-sleep! 0.05)
     (mutex-lock! mtx1)
     (update-buttons uidat *num-runs* *num-tests*)

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -228,14 +228,16 @@
   (for-each (lambda (testname)
 	      (let ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
 					(if currstate  (conc "state='" currstate "' AND ") "")
 					(if currstatus (conc "status='" currstatus "' AND ") "")
 					" testname=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
-		;;(print "QRY: " qry)
+		;;(debug:print 0 "QRY: " qry)
 		(sqlite3:execute db qry newstate newstatus testname testname)))
 	    testnames))
-	      ;; "('" (string-intersperse tests "','") "')")
+
+(define (db:delete-tests-in-state db run-id state)
+  (sqlite3:execute db "DELETE FROM tests WHERE state=? AND run_id=?;" state run-id))
 
 (define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
   (if newstate   (sqlite3:execute db "UPDATE tests SET state=?   WHERE id=?;" newstate   test-id))
   (if newstatus  (sqlite3:execute db "UPDATE tests SET status=?  WHERE id=?;" newstatus  test-id))
   (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id)))
@@ -378,13 +380,13 @@
 ;;  				(for-each (lambda (x)
 ;;  					    ;; could add check for PASS here
 ;;  					    (if (not (and (equal? (db:test-get-state x) "COMPLETED")
 ;;  							  (equal? (db:test-get-status x) "PASS")))
 ;;  						(hash-table-set! non-completed (db:test-get-testname x) x)))
-;;  					    ;; (print "Completed: " (db:test-get-testname x))))
+;;  					    ;; (debug:print 0 "Completed: " (db:test-get-testname x))))
 ;;  					  tests)
 ;;  				(filter (lambda (x)
 ;;  					  (not (hash-table-ref/default non-completed (db:test-get-testname x) #f)))
 ;;  					tests)))
 ;;  	     (pre-dep-names   (map db:test-get-testname completed-tests))
 ;;  	     (result          (lset-difference string=? waiton pre-dep-names)))
 ;;  	(print "pre-dep-names: " pre-dep-names " waiton: " waiton " result: " result)

Index: items.scm
==================================================================
--- items.scm
+++ items.scm
@@ -17,11 +17,11 @@
 (define (process-itemlist-try1 curritemkey itemlist)
   (let loop ((hed (car itemlist))
 	     (tal (cdr itemlist)))
     (if (null? tal)
 	(for-each (lambda (item)
-		    (print "curritemkey: " (append curritemkey (list item))))
+		    (debug:print 6 "curritemkey: " (append curritemkey (list item))))
 		  (cadr hed))
 	(begin
 	  (for-each (lambda (item)
 		      (process-itemlist (append curritemkey (list item)) tal))
 		    (cadr hed))
@@ -51,16 +51,32 @@
 ;;       (("ANIMAL" "Elephant") ("SEASON" "Fall")) 
 ;;       (("ANIMAL" "Lion")     ("SEASON" "Spring"))
 ;;       (("ANIMAL" "Lion")     ("SEASON" "Fall")))
 (define (item-assoc->item-list itemsdat)
   (if (and itemsdat (not (null? itemsdat)))
-      (let ((itemlst (map (lambda (x)
-			    (let ((name (car x))
-				  (items (cadr x)))
-			      (list name (string-split items))))
-			  itemsdat)))
-	(process-itemlist #f '() itemlst))
+      (let ((itemlst (filter (lambda (x)
+			       (list? x))
+			     (map (lambda (x)
+				    (debug:print 6 "item-assoc->item-list x: " x)
+				    (if (< (length x) 2)
+					(begin
+					  (debug:print 0 "ERROR: malformed items spec " (string-intersperse x " "))
+					  (list (car x)'()))
+					(let ((name (car x))
+					      (items (cadr x)))
+					  (list name (string-split items)))))
+				  itemsdat))))
+	(let ((debuglevel 5))
+	  (debug:print 5 "item-assoc->item-list: itemsdat => itemlst ")
+	  (if (>= *verbosity* 5)
+	      (begin
+		(pp itemsdat)
+		(print " => ")
+		(pp itemlst))))
+	(if (> (length itemlst) 0)
+	    (process-itemlist #f '() itemlst)
+	    '()))
       '())) ;; return a list consisting on a single null list for non-item runs
             ;; Nope, not now, return null as of 6/6/2011
 
 ;; (item-table->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Winter")))
 ;;   => ((("ANIMAL" "Elephant")("SEASON" "Spring"))
@@ -68,11 +84,11 @@
 (define (item-table->item-list itemtable)
   (let ((newlst (map (lambda (x)
 		       (if (> (length x) 1)
 			   (list (car x)
 				 (string-split (cadr x)))
-			   x))
+			   (list x '())))
 		     itemtable))
 	(res     '())) ;; a list of items
     (let loop ((indx    0)
 	       (item   '()) ;; an item will be ((KEYNAME1 VAL1)(KEYNAME2 VAL2) ...)
 	       (elflag  #f))
@@ -81,11 +97,11 @@
 			(rowdat  (cadr row)))
 		    (set! item (append item 
 				       (list 
 					(if (< indx (length rowdat))
 					    (let ((new (list rowname (list-ref rowdat indx))))
-					      ;; (print "New: " new)
+					      ;; (debug:print 0 "New: " new)
 					      (set! elflag #t)
 					      new
 					      ) ;; i.e. had at least on legit value to use
 					    (list rowname "-")))))))
 		newlst)

Index: keys.scm
==================================================================
--- keys.scm
+++ keys.scm
@@ -26,15 +26,15 @@
 
 ;; get key vals for a given run-id
 (define (get-key-vals db run-id)
   (let* ((keys (get-keys db))
 	 (res  '()))
-    ;; (print "keys: " keys " run-id: " run-id)
+    (debug:print 6 "keys: " keys " run-id: " run-id)
     (for-each 
      (lambda (key)
        (let ((qry (conc "SELECT " (key:get-fieldname key) " FROM runs WHERE id=?;")))
-	 ;; (print "qry: " qry)
+	 ;; (debug:print 0 "qry: " qry)
 	 (sqlite3:for-each-row 
 	  (lambda (key-val)
 	    (set! res (cons key-val res)))
 	  db qry run-id)))
      keys)
@@ -43,15 +43,15 @@
 ;; get key val pairs for a given run-id
 ;; ( (FIELDNAME1 keyval1) (FIELDNAME2 keyval2) ... )
 (define (keys:get-key-val-pairs db run-id)
   (let* ((keys (get-keys db))
 	 (res  '()))
-    ;; (print "keys: " keys " run-id: " run-id)
+    (debug:print 6 "keys: " keys " run-id: " run-id)
     (for-each 
      (lambda (key)
        (let ((qry (conc "SELECT " (key:get-fieldname key) " FROM runs WHERE id=?;")))
-	 ;; (print "qry: " qry)
+	 ;; (debug:print 0 "qry: " qry)
 	 (sqlite3:for-each-row 
 	  (lambda (key-val)
 	    (set! res (cons (list (key:get-fieldname key) key-val) res)))
 	  db qry run-id)))
      keys)
@@ -75,30 +75,30 @@
 (define (keys->vallist keys . withkey) ;; ORDERING IS VERY IMPORTANT, KEEP PROPER ORDER HERE!
   (let* ((keynames   (map key:get-fieldname keys))
 	 (argkeys    (map (lambda (k)(conc ":" k)) keynames))
 	 (withkey    (not (null? withkey)))
 	 (newremargs (args:get-args (cons "blah" remargs) argkeys '() args:arg-hash 0))) ;; the cons blah works around a bug in args [args assumes ("calling-prog-name" .... ) ]
-    ;;(print "remargs: " remargs " newremargs: " newremargs)
+    ;;(debug:print 0 "remargs: " remargs " newremargs: " newremargs)
     (apply append (map (lambda (x)
 			 (let ((val (args:get-arg x)))
-			   ;; (print "x: " x " val: " val)
+			   ;; (debug:print 0 "x: " x " val: " val)
 			   (if (not val)
-			       ;; (print "WARNING: missing key " x ". Specified in database but not on command line, using \"unk\"")
+			       ;; (debug:print 0 "WARNING: missing key " x ". Specified in database but not on command line, using \"unk\"")
 			       (set! val "default"))
 			   (if withkey (list x val) (list val))))
 		       argkeys))))
   
 ;; (define (keys->alist keys)
 ;;   (let* ((keynames   (map key:get-fieldname keys))
 ;; 	 (argkeys    (map (lambda (k)(conc ":" k)) keynames))
 ;; 	 (withkey    (not (null? withkey)))
 ;; 	 (newremargs (args:get-args (cons "blah" remargs) argkeys '() args:arg-hash 0))) ;; the cons blah works around a bug in args
-;;     (print "remargs: " remargs " newremargs: " newremargs)
+;;     (debug:print 0 "remargs: " remargs " newremargs: " newremargs)
 ;;     (apply append (map (lambda (x)
 ;; 			 (let ((val (args:get-arg x)))
 ;; 			   (if (not val)
-;; 			       (print "ERROR: Ignoring key " x " found in database but not on command line"))
+;; 			       (debug:print 0 "ERROR: Ignoring key " x " found in database but not on command line"))
 ;; 			   (if withkey (list x val) (list val))))
 ;; 		       argkeys))))
 
 (define (keystring->keys keystring)
   (map (lambda (x)

Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -17,21 +17,21 @@
   (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config")))
   (set! *configdat*  (if (car *configinfo*)(car *configinfo*) #f))
   (set! *toppath*    (if (car *configinfo*)(cadr *configinfo*) #f))
   (if *toppath*
       (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
-      (print "ERROR: failed to find the top path to your run setup."))
+      (debug:print 0 "ERROR: failed to find the top path to your run setup."))
   *toppath*)
 
 (define (setup-env-defaults db fname run-id . already-seen)
   (let* ((keys    (get-keys db))
 	 (keyvals (get-key-vals db run-id))
 	 (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/"))
 	 (confdat (read-config fname))
 	 (whatfound (make-hash-table))
 	 (sections (list "default" thekey)))
-    ;; (print "Using key=\"" thekey "\"")
+    (debug:print 4 "Using key=\"" thekey "\"")
     (for-each 
      (lambda (section)
        (let ((section-dat (hash-table-ref/default confdat section #f)))
 	 (if section-dat
 	     (for-each 
@@ -41,15 +41,15 @@
 	      (map car section-dat)))))
      sections)
     (if (and (not (null? already-seen))
 	     (not (car already-seen)))
 	(begin
-	  (print "Key settings found in runconfig.config:")
+	  (debug:print 2 "Key settings found in runconfig.config:")
 	  (for-each (lambda (fullkey)
-		      (format #t "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))
+		      (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0))))
 		    sections)
-	  (print "---")
+	  (debug:print 2 "---")
 	  (set! *already-seen-runconfig-info* #t)))))
 
 (define (get-best-disk confdat)
   (let* ((disks    (hash-table-ref/default confdat "disks" #f))
 	 (best     #f)
@@ -59,11 +59,11 @@
 	 (lambda (disk-num)
 	   (let* ((dirpath    (cadr (assoc disk-num disks)))
 		  (freespc    (if (directory? dirpath)
 				  (get-df dirpath)
 				  (begin
-				    (print "WARNING: path " dirpath " in [disks] section not valid")
+				    (debug:print 0 "WARNING: path " dirpath " in [disks] section not valid")
 				    0))))
 	     (if (> freespc bestsize)
 		 (begin
 		   (set! best     dirpath)
 		   (set! bestsize freespc)))))
@@ -87,21 +87,24 @@
 			 "/" key-str "/" runname item-path)))
     ;; since this is an iterated test this is as good a place as any to
     ;; update the toptest record with its location rundir
     (if (not (equal? item-path ""))
 	(db:test-set-rundir! db run-id testname "" toptest-path))
-    (print "Setting up test run area")
-    (print " - creating run area in " dfullp)
+    (debug:print 2 "Setting up test run area")
+    (debug:print 2 " - creating run area in " dfullp)
     (system  (conc "mkdir -p " dfullp))
-    (print " - creating link from " dfullp "/" testname " to " lnkpath)
+    (debug:print 2 " - creating link from " dfullp "/" testname " to " lnkpath)
     (system  (conc "mkdir -p " lnkpath))
     (if (file-exists? (conc lnkpath "/" testname))
 	(system (conc "rm -f " lnkpath "/" testname)))
     (system  (conc "ln -sf " dfullp " " lnkpath "/" testname))
     (if (directory? dfullp)
 	(begin
-	  (system  (conc "rsync -av " test-path "/ " dfullp "/"))
+	  (let* ((cmd    (conc "rsync -av" (if (> *verbosity* 1) "" "q") " " test-path "/ " dfullp "/"))
+		 (status (system cmd)))
+	    (if (not (eq? status 0))
+		(debug:print 2 "ERROR: problem with running \"" cmd "\"")))
 	  (list dfullp toptest-path))
 	(list #f #f))))
 
 ;; 1. look though disks list for disk with most space
 ;; 2. create run dir on disk, path name is meaningful
@@ -136,11 +139,11 @@
 	(let ((dat  (create-work-area db run-id test-path diskpath test-name itemdat)))
 	  (set! work-area (car dat))
 	  (set! toptest-work-area (cadr dat)))
 	(begin
 	  (set! work-area test-path)
-	  (print "WARNING: No disk work area specified - running in the test directory")))
+	  (debug:print 0 "WARNING: No disk work area specified - running in the test directory")))
     (set! cmdparms (base64:base64-encode (with-output-to-string
 				    (lambda () ;; (list 'hosts     hosts)
 				      (write (list (list 'testpath  test-path)
 						   (list 'work-area work-area)
 						   (list 'test-name test-name) 
@@ -160,11 +163,11 @@
      (launcher
       (set! fullcmd (append launcher (list remote-megatest "-execute" cmdparms))))
      (else
       (set! fullcmd (list remote-megatest "-execute" cmdparms))))
     (if (args:get-arg "-xterm")(set! fullcmd (append fullcmd (list "-xterm"))))
-    (print "Launching megatest for test " test-name " in " work-area" ...")
+    (debug:print 1 "Launching megatest for test " test-name " in " work-area" ...")
     (test-set-status! db run-id test-name "LAUNCHED" "n/a" itemdat) ;; (if launch-results launch-results "FAILED"))
     ;; set 
     ;; set pre-launch-env-vars before launching, keep the vars in prevvals and put the envionment back when done
     (let* ((commonprevvals (alist->env-vars
 			    (hash-table-ref/default *configdat* "env-override" '())))
@@ -177,10 +180,10 @@
 				    itemdat)))
 	   (launch-results (apply cmd-run-proc-each-line
 				  (car fullcmd)
 				  print
 				  (cdr fullcmd)))) ;;  launcher fullcmd)));; (apply cmd-run-proc-each-line launcher print fullcmd))) ;; (cmd-run->list fullcmd))
-      (print "Launching completed, updating db")
+      (debug:print 2 "Launching completed, updating db")
       (alist->env-vars miscprevvals)
       (alist->env-vars testprevvals)
       (alist->env-vars commonprevvals))))
 

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -6,11 +6,11 @@
 ;;  This program is distributed WITHOUT ANY WARRANTY; without even the
 ;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 ;;  PURPOSE.
 
 (include "common.scm")
-(define megatest-version 1.12)
+(define megatest-version 1.17)
 
 (define help (conc "
 Megatest, documentation at http://www.kiatoa.com/fossils/megatest
   version " megatest-version "
   license GPL, Copyright Matt Welland 2006-2011
@@ -86,10 +86,11 @@
 			"-set-toplog"
 			"-runstep"
 			"-logpro"
 			"-m"
 			"-rerun"
+			"-debug" ;; for *verbosity* > 2
 			) 
 		 (list  "-h"
 		        "-force"
 		        "-xterm"
 		        "-showkeys"
@@ -97,10 +98,12 @@
 		        "-gui"
 			"-runall"    ;; run all tests
 			"-remove-runs"
 			"-keepgoing"
 			"-usequeue"
+			"-v" ;; verbose 2, more than normal (normal is 1)
+			"-q" ;; quiet 0, errors/warnings only
 		       )
 		 args:arg-hash
 		 0))
 
 (if (args:get-arg "-h")
@@ -121,36 +124,42 @@
 
 ;;======================================================================
 ;; Misc setup stuff
 ;;======================================================================
 
+(set! *verbosity* (cond
+		   ((args:get-arg "-debug")(string->number (args:get-arg "-debug")))
+		   ((args:get-arg "-v")    2)
+		   ((args:get-arg "-q")    0)
+		   (else                   1)))
+
 ;;======================================================================
 ;; Remove old run(s)
 ;;======================================================================
 
 ;; since several actions can be specified on the command line the removal
 ;; is done first
 (define (remove-runs)
   (cond
    ((not (args:get-arg ":runname"))
-    (print "ERROR: Missing required parameter for -remove-runs, you must specify the run name pattern with :runname patt")
+    (debug:print 0 "ERROR: Missing required parameter for -remove-runs, you must specify the run name pattern with :runname patt")
     (exit 2))
    ((not (args:get-arg "-testpatt"))
-    (print "ERROR: Missing required parameter for -remove-runs, you must specify the test pattern with -testpatt")
+    (debug:print 0 "ERROR: Missing required parameter for -remove-runs, you must specify the test pattern with -testpatt")
     (exit 3))
    ((not (args:get-arg "-itempatt"))
     (print "ERROR: Missing required parameter for -remove-runs, you must specify the items with -itempatt")
     (exit 4))
    ((let ((db #f))
       (if (not (setup-for-run))
 	  (begin 
-	    (print "Failed to setup, exiting")
+	    (debug:print 0 print "Failed to setup, exiting")
 	    (exit 1)))
       (set! db (open-db))
       (if (not (car *configinfo*))
 	  (begin
-	    (print "ERROR: Attempted to remove test(s) but run area config file not found")
+	    (debug:print 0 "ERROR: Attempted to remove test(s) but run area config file not found")
 	    (exit 1))
 	  ;; put test parameters into convenient variables
 	  (runs:remove-runs db
 			    (args:get-arg ":runname")
 			    (args:get-arg "-testpatt")
@@ -178,11 +187,11 @@
 	   (keys     (db-get-keys db))
 	   (keynames (map key:get-fieldname keys)))
       ;; Each run
       (for-each 
        (lambda (run)
-	 (print "Run: "
+	 (debug:print 2 "Run: "
 		(string-intersperse (map (lambda (x)
 					   (db:get-value-by-header run header x))
 					 keynames) "/")
 		"/"
 		(db:get-value-by-header run header "runname"))
@@ -219,14 +228,10 @@
 				   "    Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
 				   (db:step-get-stepname step)
 				   (db:step-get-state step)
 				   (db:step-get-status step)
 				   (db:step-get-event_time step)))
-			;;    (print "    Step: " (db:step-get-stepname step)
-			;; 	  " " (db:step-get-state step)
-			;; 	  " " (db:step-get-status step)
-			;; 	  " " (db:step-get-event_time step)))
 			 steps)))))
 		tests))))
        runs)
       (set! *didsomething* #t)
       ))
@@ -251,25 +256,25 @@
 
 ;; run all tests are are Not COMPLETED and PASS or CHECK
 (if (args:get-arg "-runall")
     (if (not (args:get-arg ":runname"))
 	(begin
-	  (print "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname")
+	  (debug:print 0 "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname")
 	  (exit 2))
 	(let* ((db      (if (setup-for-run)
 			    (open-db)
 			    (begin
-			      (print "Failed to setup, exiting")
+			      (debug:print 0 "Failed to setup, exiting")
 			      (exit 1)))))
 	  (if (not (car *configinfo*))
 	      (begin
-		(print "ERROR: Attempted to run a test but run area config file not found")
+		(debug:print 0 "ERROR: Attempted to run a test but run area config file not found")
 		(exit 1))
 	      ;; put test parameters into convenient variables
 	      (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now
-		(print "INFO: Attempting to start the following tests...")
-		(print "     " (string-intersperse test-names ","))
+		(debug:print 1 "INFO: Attempting to start the following tests...")
+		(debug:print 1 "     " (string-intersperse test-names ","))
 		(run-tests db test-names)))
 	  ;; (run-waiting-tests db)
 	  (sqlite3:finalize! db)
 	  (set! *didsomething* #t))))
 
@@ -291,21 +296,21 @@
 ;;    - if cannot access db > allowed disconnect time then kill job
 
 (define (runtests)
   (if (not (args:get-arg ":runname"))
       (begin
-	(print "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname")
+	(debug:print 0 "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname")
 	(exit 2))
       (let ((db #f))
 	(if (not (setup-for-run))
 	    (begin 
-	      (print "Failed to setup, exiting")
+	      (debug:print 0 "Failed to setup, exiting")
 	      (exit 1)))
 	(set! db (open-db))
 	(if (not (car *configinfo*))
 	    (begin
-	      (print "ERROR: Attempted to run a test but run area config file not found")
+	      (debug:print 0 "ERROR: Attempted to run a test but run area config file not found")
 	      (exit 1))
 	    ;; put test parameters into convenient variables
 	    (let* ((test-names   (string-split (args:get-arg "-runtests") ",")))
 	      (run-tests db test-names)))
 	;; run-waiting-tests db)
@@ -339,11 +344,11 @@
 		 (runname   (assoc/default 'runname   cmdinfo))
 		 (megatest  (assoc/default 'megatest  cmdinfo))
 		 (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))
 		 (fullrunscript (conc testpath "/" runscript))
 		 (db        #f))
-	    (print "Exectuing " test-name " on " (get-host-name))
+	    (debug:print 2 "Exectuing " test-name " on " (get-host-name))
 	    (change-directory testpath)
 	    (setenv "MT_TEST_RUN_DIR" work-area)
 	    (setenv "MT_TEST_NAME" test-name)
 	    (setenv "MT_ITEM_INFO" (conc itemdat))
 	    (setenv "MT_RUNNAME"   runname)
@@ -350,19 +355,19 @@
 	    (setenv "MT_MEGATEST"  megatest)
 	    (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path))
 	    
 	    (if (not (setup-for-run))
 		(begin
-		  (print "Failed to setup, exiting") 
+		  (debug:print 0 "Failed to setup, exiting") 
 		  (exit 1)))
 	    ;; now can find our db
 	    (set! db (open-db))
 	    (change-directory work-area) 
 	    (let ((runconfigf (conc  *toppath* "/runconfigs.config")))
 	      (if (file-exists? runconfigf)
 		  (setup-env-defaults db runconfigf run-id)
-		  (print "WARNING: You do not have a run config file: " runconfigf)))
+		  (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)))
             ;; environment overrides are done *before* the remaining critical envars.
             (alist->env-vars env-ovrd)
 	    (set-megatest-env-vars db run-id)
 	    (set-item-env-vars itemdat)
             (save-environment-as-files "megatest")
@@ -421,11 +426,11 @@
 					     (begin
 					       (mutex-lock! m)
 					       (let* ((pid (vector-ref exit-info 0)))
 						 (if (number? pid)
 						     (begin
-						       (print "WARNING: Request received to kill job (attempt # " kill-tries ")")
+						       (debug:print 0 "WARNING: Request received to kill job (attempt # " kill-tries ")")
 						       ;;(cond
 						       ;;((>   kill-tries 0) ; 2)
 						       (let ((processes (cmd-run->list (conc "pgrep -l -P " pid))))
 							 (for-each 
 							  (lambda (p)
@@ -433,29 +438,29 @@
 								   (p-id   (if (> (length parts) 0)
 									       (string->number (car parts))
 									       #f)))
 							      (if p-id
 								  (begin
-								    (print "Killing " (cadr parts) "; kill -9  " p-id)
+								    (debug:print 0 "Killing " (cadr parts) "; kill -9  " p-id)
 								    (system (conc "kill -9 " p-id))))))
 							  (car processes))
 							 (system (conc "kill -9 " pid))))
 						     ;;(let* ((ppid (process-group-id pid))
 						     ;;       (kcmd (conc "pkill -9 -g " ppid)))
 						     ;;  ;; (process-signal pid signal/term)
 						     ;;  ;; (process-signal pid signal/kill)
-						     ;;  (print "Attempting to kill pid " pid " and children in process group " ppid " with command:\n    " kcmd)
-						     ;;  (print "Children:")
+						     ;;  (debug:print 0 "Attempting to kill pid " pid " and children in process group " ppid " with command:\n    " kcmd)
+						     ;;  (debug:print 0 "Children:")
 						     ;;  (system (conc "pgrep -g -l " ppid))
 						     ;;  (system kcmd)
 						     ;;  (sleep 1) ;; give it a rest
 						     ;;  (test-set-status! db run-id test-name "KILLED"  "FAIL"
 						     ;;       	     itemdat (args:get-arg "-m"))
 						     ;;  (sqlite3:finalize! db)
 						     ;;  (exit 1)))))
 						     (begin
-						       (print "WARNING: Request received to kill job but problem with process, attempting to kill manager process")
+						       (debug:print 0 "WARNING: Request received to kill job but problem with process, attempting to kill manager process")
 						       (test-set-status! db run-id test-name "KILLED"  "FAIL"
 									 itemdat (args:get-arg "-m"))
 						       (sqlite3:finalize! db)
 						       (exit 1))))
 					       ;;     (thread-terminate! job-thread)))
@@ -462,19 +467,19 @@
 					       (set! kill-tries (+ 1 kill-tries))
 					       (mutex-unlock! m)))
 					 ;; (handle-exceptions
 					       ;;  exn
 					       ;;  (begin
-					       ;;    (print "ERROR: Problem killing process " (vector-ref exit-info 0))
+					       ;;    (debug:print 0 "ERROR: Problem killing process " (vector-ref exit-info 0))
 					       ;;    (abort exn))
 					       ;;  (let* ((pid   (vector-ref exit-info 0))
 					       ;;         ;; (pgid  (process-group-id pid))
 					       ;;         ;; (cmd  (conc "pkill -9 -P " pgid))
 					       ;;         )
-					       ;;    ;; (print "Running \"" cmd "\"")
+					       ;;    ;; (debug:print 0 "Running \"" cmd "\"")
 					       ;;    ;; (system cmd)
-					       ;;    (print "Running \"kill -9 " pid "\"")
+					       ;;    (debug:print 0 "Running \"kill -9 " pid "\"")
 					       ;;    (system (conc "kill -9 " pid))
 					       ;;    ;; (process-signal (vector-ref exit-info 0) signal/kill)
 					       ;;    ))))
 					 (sqlite3:finalize! db)
 					 (thread-sleep! (+ 8 (random 4))) ;; add some jitter to the call home time to spread out the db accesses
@@ -488,11 +493,11 @@
 	      (mutex-lock! m)
 	      (set! db (open-db))
 	      (let* ((testinfo (db:get-test-info db run-id test-name (item-list->path itemdat))))
 		(if (not (equal? (db:test-get-state testinfo) "COMPLETED"))
 		    (begin
-		      (print "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result")
+		      (debug:print 2 "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result")
 		      (test-set-status! db run-id test-name
 					(if kill-job? "KILLED" "COMPLETED")
 					(if (vector-ref exit-info 1) ;; look at the exit-status
 					    (if (and (not kill-job?) 
 						     (eq? (vector-ref exit-info 2) 0))
@@ -500,21 +505,21 @@
 						"FAIL")
 					    "FAIL") itemdat (args:get-arg "-m")))))
 	      (mutex-unlock! m)
 	      ;; (exec-results (cmd-run->list fullrunscript)) ;;  (list ">" (conc test-name "-run.log"))))
 	      ;; (success      exec-results)) ;; (eq? (cadr exec-results) 0)))
-	      (print "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " 
+	      (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " 
 		     work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n")
 	      (sqlite3:finalize! db)
 	      (if (not (vector-ref exit-info 1))
 		  (exit 4)))))
       (set! *didsomething* #t)))
 
 (if (args:get-arg "-step")
     (if (not (getenv "MT_CMDINFO"))
 	(begin
-	  (print "ERROR: MT_CMDINFO env var not set, -step must be called *inside* a megatest invoked environment!")
+	  (debug:print 0 "ERROR: MT_CMDINFO env var not set, -step must be called *inside* a megatest invoked environment!")
 	  (exit 5))
 	(let* ((step      (args:get-arg "-step"))
 	       (cmdinfo   (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
 	       (testpath  (assoc/default 'testpath  cmdinfo))
 	       (test-name (assoc/default 'test-name cmdinfo))
@@ -526,17 +531,17 @@
 	       (state    (args:get-arg ":state"))
 	       (status   (args:get-arg ":status")))
 	  (change-directory testpath)
 	  (if (not (setup-for-run))
 	      (begin
-		(print "Failed to setup, exiting")
+		(debug:print 0 "Failed to setup, exiting")
 		(exit 1)))
 	  (set! db (open-db))
 	  (if (and state status)
 	      (teststep-set-status! db run-id test-name step state status itemdat (args:get-arg "-m"))
 	      (begin
-		(print "ERROR: You must specify :state and :status with every call to -step")
+		(debug:print 0 "ERROR: You must specify :state and :status with every call to -step")
 		(exit 6)))
 	  (sqlite3:finalize! db)
 	  (set! *didsomething* #t))))
 
 (if (or (args:get-arg "-setlog")       ;; since setting up is so costly lets piggyback on -test-status
@@ -543,11 +548,11 @@
 	(args:get-arg "-set-toplog")
 	(args:get-arg "-test-status")
 	(args:get-arg "-runstep"))
     (if (not (getenv "MT_CMDINFO"))
 	(begin
-	  (print "ERROR: MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!")
+	  (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 (base64:base64-decode (getenv "MT_CMDINFO")))))
 	       (testpath  (assoc/default 'testpath  cmdinfo))
 	       (test-name (assoc/default 'test-name cmdinfo))
@@ -559,21 +564,21 @@
 	       (state     (args:get-arg ":state"))
 	       (status    (args:get-arg ":status")))
 	  (change-directory testpath)
 	  (if (not (setup-for-run))
 	      (begin
-		(print "Failed to setup, exiting")
+		(debug:print 0 "Failed to setup, exiting")
 		(exit 1)))
 	  (set! db (open-db))
 	  (if (args:get-arg "-setlog")
 	      (test-set-log! db run-id test-name itemdat (args:get-arg "-setlog")))
 	  (if (args:get-arg "-set-toplog")
 	      (test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
 	  (if (args:get-arg "-runstep")
 	      (if (null? remargs)
 		  (begin
-		    (print "ERROR: nothing specified to run!")
+		    (debug:print 0 "ERROR: nothing specified to run!")
 		    (sqlite3:finalize! db)
 		    (exit 6))
 		  (let* ((stepname   (args:get-arg "-runstep"))
 			 (logprofile (args:get-arg "-logpro"))
 			 (logfile    (conc stepname ".log"))
@@ -590,11 +595,11 @@
 		    ;; mark the start of the test
 		    (teststep-set-status! db run-id test-name stepname "start" "n/a" itemdat (args:get-arg "-m"))
 		    ;; close the db
 		    (sqlite3:finalize! db)
 		    ;; run the test step
-		    (print "INFO: Running \"" fullcmd "\"")
+		    (debug:print 2 "INFO: Running \"" fullcmd "\"")
 		    (change-directory startingdir)
 		    (set! exitstat (system fullcmd)) ;; cmd params))
 		    (set! *globalexitstatus* exitstat)
 		    (change-directory testpath)
 		    ;; re-open the db
@@ -602,11 +607,11 @@
 		    ;; run logpro if applicable ;; (process-run "ls" (list "/foo" "2>&1" "blah.log"))
 		    (if logprofile
 			(let* ((htmllogfile (conc stepname ".html"))
 			       (oldexitstat exitstat)
 			       (cmd         (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
-			  (print "INFO: running \"" cmd "\"")
+			  (debug:print 2 "INFO: running \"" cmd "\"")
 			  (change-directory startingdir)
 			  (set! exitstat (system cmd))
 			  (set! *globalexitstatus* exitstat) ;; no necessary
 			  (change-directory testpath)
 			  (test-set-log! db run-id test-name itemdat htmllogfile)))
@@ -624,11 +629,11 @@
 				(else status))))
 		(test-set-status! db run-id test-name state newstatus itemdat (args:get-arg "-m")))
 	      (if (and state status)
 		  (if (not (args:get-arg "-setlog"))
 		      (begin
-			(print "ERROR: You must specify :state and :status with every call to -test-status\n" help)
+			(debug:print 0 "ERROR: You must specify :state and :status with every call to -test-status\n" help)
 			(sqlite3:finalize! db)
 			(exit 6)))))
 	  (sqlite3:finalize! db)
 	  (set! *didsomething* #t))))
 
@@ -635,32 +640,32 @@
 (if (args:get-arg "-showkeys")
     (let ((db #f)
 	  (keys #f))
       (if (not (setup-for-run))
 	  (begin
-	    (print "Failed to setup, exiting")
+	    (debug:print 0 "Failed to setup, exiting")
 	    (exit 1)))
       (set! db (open-db))
       (set! keys (db-get-keys db))
-      (print "Keys: " (string-intersperse (map key:get-fieldname keys) ", "))
+      (debug:print 1 "Keys: " (string-intersperse (map key:get-fieldname keys) ", "))
       (sqlite3:finalize! db)
       (set! *didsomething* #t)))
 
 (if (args:get-arg "-gui")
     (begin
-      (print "Look at the dashboard for now")
+      (debug:print 0 "Look at the dashboard for now")
       ;; (megatest-gui)
       (set! *didsomething* #t)))
 
 (if (not *didsomething*)
-    (print help))
+    (debug:print 0 help))
 
 (if (not (eq? *globalexitstatus* 0))
     (if (or (args:get-arg "-runtests")(args:get-arg "-runall"))
         (begin
-           (print "NOTE: Subprocesses with non-zero exit code detected: " *globalexitstatus*)
+           (debug:print 0 "NOTE: Subprocesses with non-zero exit code detected: " *globalexitstatus*)
            (exit 0))
         (case *globalexitstatus*
          ((0)(exit 0))
          ((1)(exit 1))
          ((2)(exit 2))
          (else (exit 3)))))

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -21,28 +21,28 @@
 	 (state     (get-with-default ":state" "no"))
 	 (status    (get-with-default ":status" "n/a"))
 	 (allvals   (append (list runname state status user) keyvallst))
 	 (qryvals   (append (list runname) keyvallst))
 	 (key=?str  (string-intersperse (map (lambda (k)(conc (key:get-fieldname k) "=?")) keys) " AND ")))
-    ;; (print "keys: " keys " allvals: " allvals " keyvallst: " keyvallst)
-    (print "NOTE: using key " (string-intersperse keyvallst "/") " for this run")
+    (debug:print 3 "keys: " keys " allvals: " allvals " keyvallst: " keyvallst)
+    (debug:print 2 "NOTE: using key " (string-intersperse keyvallst "/") " for this run")
     (if (and runname (null? (filter (lambda (x)(not x)) keyvallst))) ;; there must be a better way to "apply and"
 	(let ((res #f))
 	  (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time" comma keystr ") VALUES (?,?,?,?,strftime('%s','now')" comma valslots ");")
 		 allvals)
 	  (apply sqlite3:for-each-row 
 	   (lambda (id)
 	     (set! res id))
 	   db
 	   (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
-	     ;; (print "qry: " qry) 
+	     ;(debug:print 4 "qry: " qry) 
 	     qry)
 	   qryvals)
 	  (sqlite3:execute db "UPDATE runs SET state=?,status=? WHERE id=?;" state status res)
 	  res) 
 	(begin
-	  (print "ERROR: Called without all necessary keys")
+	  (debug:print 0 "ERROR: Called without all necessary keys")
 	  #f))))
 
 ;; runs:get-runs-by-patt
 ;; get runs by list of criteria
 ;; register a test run with the db
@@ -62,11 +62,11 @@
 		       (fulkey (conc ":" key))
 		       (patt   (args:get-arg fulkey)))
 		  (if patt
 		      (set! key-patt (conc key-patt " AND " key " like '" patt "'"))
 		      (begin
-			(print "ERROR: searching for runs with no pattern set for " fulkey)
+			(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
 			(exit 6)))))
 	      keys)
     (sqlite3:for-each-row 
      (lambda (a . r)
        (set! res (cons (list->vector (cons a r)) res)))
@@ -159,26 +159,26 @@
 	(if (member item valid-values)
 	    item #f)
 	item)))
 
 (define (teststep-set-status! db run-id test-name teststep-name state-in status-in itemdat comment)
-  ;; (print "run-id: " run-id " test-name: " test-name)
+  (debug:print 4 "run-id: " run-id " test-name: " test-name)
   (let* ((state     (check-valid-items "state" state-in))
 	 (status    (check-valid-items "status" status-in))
 	 (item-path (item-list->path itemdat))
 	 (testdat   (db:get-test-info db run-id test-name item-path)))
-    ;; (print "testdat: " testdat)
+    (debug:print 5 "testdat: " testdat)
     (if (and testdat ;; if the section exists then force specification BUG, I don't like how this works.
 	     (or (not state)(not status)))
-	(print "WARNING: Invalid " (if status "status" "state")
+	(debug:print 0 "WARNING: Invalid " (if status "status" "state")
 	       " value \"" (if status status-in state-in) "\", update your validstates section in megatest.config"))
     (if testdat
 	(let ((test-id (test:get-id testdat)))
 	  (sqlite3:execute db 
 			"INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment) VALUES(?,?,?,?,strftime('%s','now'),?);"
 			test-id teststep-name state status (if comment comment "")))
-	(print "ERROR: Can't update " test-name " for run " run-id " -> no such test in db"))))
+	(debug:print 0 "ERROR: Can't update " test-name " for run " run-id " -> no such test in db"))))
 
 (define (test-get-kill-request db run-id test-name itemdat)
   (let* ((item-path (item-list->path itemdat))
 	 (testdat   (db:get-test-info db run-id test-name item-path)))
     (equal? (test:get-state testdat) "KILLREQ")))
@@ -202,13 +202,13 @@
 
 (define (test-update-meta-info db run-id testname itemdat minutes)
   (let ((item-path (item-list->path itemdat))
 	(cpuload  (get-cpu-load))
 	(diskfree (get-df (current-directory))))
-    (if (not cpuload)  (begin (print "WARNING: CPULOAD not found.")  (set! cpuload "n/a")))
-    (if (not diskfree) (begin (print "WARNING: DISKFREE not found.") (set! diskfree "n/a")))
-    (if (not item-path)(begin (print "WARNING: ITEMPATH not set.")   (set! item-path "")))
+    (if (not cpuload)  (begin (debug:print 0 "WARNING: CPULOAD not found.")  (set! cpuload "n/a")))
+    (if (not diskfree) (begin (debug:print 0 "WARNING: DISKFREE not found.") (set! diskfree "n/a")))
+    (if (not item-path)(begin (debug:print 0 "WARNING: ITEMPATH not set.")   (set! item-path "")))
     ;; (let ((testinfo (db:get-test-info db run-id testname item-path)))
     ;;   (if (and (not (equal? (db:test-get-status testinfo) "COMPLETED"))
     ;;            (not (equal? (db:test-get-status testinfo) "KILLREQ"))
     (sqlite3:execute
      db
@@ -223,44 +223,44 @@
 (define (set-megatest-env-vars db run-id)
   (let ((keys (db-get-keys db)))
     (for-each (lambda (key)
 		(sqlite3:for-each-row
 		 (lambda (val)
-		   (print "setenv " (key:get-fieldname key) " " val)
+		   (debug:print 2 "setenv " (key:get-fieldname key) " " val)
 		   (setenv (key:get-fieldname key) val))
 		 db 
 		 (conc "SELECT " (key:get-fieldname key) " FROM runs WHERE id=?;")
 		 run-id))
 	      keys)))
 
 (define (set-item-env-vars itemdat)
   (for-each (lambda (item)
-	      (print "setenv " (car item) " " (cadr item))
+	      (debug:print 2 "setenv " (car item) " " (cadr item))
 	      (setenv (car item) (cadr item)))
 	    itemdat))
 
 (define (get-all-legal-tests)
   (let* ((tests  (glob (conc *toppath* "/tests/*")))
 	 (res    '()))
-    ;; (print "INFO: Looking at tests " (string-intersperse tests ","))
+    (debug:print 4 "INFO: Looking at tests " (string-intersperse tests ","))
     (for-each (lambda (testpath)
 		(if (file-exists? (conc testpath "/testconfig"))
 		    (set! res (cons (last (string-split testpath "/")) res))))
 	      tests)
     res))
 
 (define (runs:can-run-more-tests db)
   (let ((num-running (db:get-count-tests-running db))
 	(max-concurrent-jobs (config-lookup *configdat* "setup" "max_concurrent_jobs")))
-    ;; (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
+    (debug:print 2 "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
     (if (or (not max-concurrent-jobs)
 	    (and max-concurrent-jobs
 		 (string->number max-concurrent-jobs)
 		 (not (>= num-running (string->number max-concurrent-jobs)))))
 	#t
 	(begin 
-	  (print "WARNING: Max running jobs exceeded, current number running: " num-running 
+	  (debug:print 0 "WARNING: Max running jobs exceeded, current number running: " num-running 
 			 ", max_concurrent_jobs: " max-concurrent-jobs)
 	  #f))))
   
 (define (run-tests db test-names)
   (let* ((keys        (db-get-keys db))
@@ -268,11 +268,17 @@
 	 (run-id      (register-run db keys))) ;;  test-name)))
     ;; on the first pass or call to run-tests set FAILS to NOT_STARTED if
     ;; -keepgoing is specified
     (if (and (eq? *passnum* 0)
 	     (args:get-arg "-keepgoing"))
-	(db:set-tests-state-status db run-id test-names #f "FAIL" "NOT_STARTED" "FAIL"))
+	(begin
+	  ;; have to delete test records where NOT_STARTED since they can cause -keepgoing to 
+	  ;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends 
+	  ;; on test A but test B reached the point on being registered as NOT_STARTED and test
+	  ;; A failed for some reason then on re-run using -keepgoing the run can never complete.
+	  (db:delete-tests-in-state db run-id "NOT_STARTED")
+	  (db:set-tests-state-status db run-id test-names #f "FAIL" "NOT_STARTED" "FAIL")))
     (set! *passnum* (+ *passnum* 1))
     (let loop ((numtimes 0))
       (for-each 
        (lambda (test-name)
 	 (if (runs:can-run-more-tests db)
@@ -283,18 +289,18 @@
       ;; (run-waiting-tests db)
       (if (args:get-arg "-keepgoing")
 	  (let ((estrem (db:estimated-tests-remaining db run-id)))
 	    (if (> estrem 0)
 		(begin
-		  (print "Keep going, estimated " estrem " tests remaining to run, will continue in 10 seconds ...")
-		  (sleep 10)
+		  (debug:print 1 "Keep going, estimated " estrem " tests remaining to run, will continue in 3 seconds ...")
+		  (sleep 3)
 		  (run-waiting-tests db)
 		  (loop (+ numtimes 1)))))))))
 	   
 ;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc
 (define (run-one-test db run-id test-name keyvallst)
-  (print "Launching test " test-name)
+  (debug:print 1 "Launching test " test-name)
   ;; All these vars might be referenced by the testconfig file reader
   (setenv "MT_TEST_NAME" test-name) ;; 
   (setenv "MT_RUNNAME"   (args:get-arg ":runname"))
   (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
   (change-directory *toppath*)
@@ -304,11 +310,11 @@
 	 (test-conf    (if testexists (read-config test-configf) (make-hash-table)))
 	 (waiton       (let ((w (config-lookup test-conf "requirements" "waiton")))
 			 (if (string? w)(string-split w)'()))))
     (if (not testexists)
 	(begin
-	  (print "ERROR: Can't find config file " test-configf)
+	  (debug:print 0 "ERROR: Can't find config file " test-configf)
 	  (exit 2))
 	;; put top vars into convenient variables and open the db
 	(let* (;; db is always at *toppath*/db/megatest.db
 	       (items       (hash-table-ref/default test-conf "items" '()))
 	       (itemstable  (hash-table-ref/default test-conf "itemstable" '()))
@@ -315,13 +321,20 @@
 	       (allitems    (if (or (not (null? items))(not (null? itemstable)))
 				(append (item-assoc->item-list items)
 					(item-table->item-list itemstable))
 				'(()))) ;; a list with one null list is a test with no items
 	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
-	  (print "items: ")(pp allitems)
+	  (debug:print 1 "items: ")
+	  (if (>= *verbosity* 1)(pp allitems))
+	  (if (>= *verbosity* 5)
+	      (begin
+		(print "items: ")(pp (item-assoc->item-list items))
+		(print "itestable: ")(pp (item-table->item-list itemstable))))
 	  (if (args:get-arg "-m")
 	      (db:set-comment-for-run db run-id (args:get-arg "-m")))
+	  ;; braindead work-around for poorly specified allitems list BUG!!! FIXME
+	  (if (null? allitems)(set! allitems '(())))
 	  (let loop ((itemdat (car allitems))
 		     (tal     (cdr allitems)))
 	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
 	    ;; Handle lists of items
 	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
@@ -331,11 +344,11 @@
 		   (num-running (db:get-count-tests-running db))
 		   (max-concurrent-jobs (config-lookup *configdat* "setup" "max_concurrent_jobs"))
 		   (parent-test (and (not (null? items))(equal? item-path "")))
 		   (single-test (and (null? items) (equal? item-path "")))
 		   (item-test   (not (equal? item-path ""))))
-	      ;; (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
+	      (debug:print 3 "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
 	      (if (runs:can-run-more-tests db)
 		  (begin
 		    (let loop2 ((ts (db:get-test-info db run-id test-name item-path)) ;; #f)
 				(ct 0))
 		      (if (and (not ts)
@@ -346,28 +359,28 @@
 			    (loop2 (db:get-test-info db run-id test-name item-path)
 				   (+ ct 1)))
 			  (if ts
 			      (set! testdat ts)
 			      (begin
-				(print "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping")
+				(debug:print 0 "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping")
 				(if (not (null? tal))
 				    (loop (car tal)(cdr tal)))))))
 		    (change-directory test-path)
 		    ;; this block is here only to inform the user early on
 		    (if (file-exists? runconfigf)
 			(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*)
-			(print "WARNING: You do not have a run config file: " runconfigf))
-		    ;; (print "run-id: " run-id " test-name: " test-name " item-path: " item-path " testdat: " (test:get-status testdat) " test-state: " (test:get-state testdat))
+			(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
+		    (debug:print 4 "run-id: " run-id " test-name: " test-name " item-path: " item-path " testdat: " (test:get-status testdat) " test-state: " (test:get-state testdat))
 		    (case (if (args:get-arg "-force")
 			      'NOT_STARTED
 			      (if testdat
 				  (string->symbol (test:get-state testdat))
 				  'failed-to-insert))
 		      ((failed-to-insert)
-		       (print "ERROR: Failed to insert the record into the db"))
+		       (debug:print 0 "ERROR: Failed to insert the record into the db"))
 		      ((NOT_STARTED COMPLETED)
-		       ;; (print "Got here, " (test:get-state testdat))
+		       (debug:print 6 "Got here, " (test:get-state testdat))
 		       (let ((runflag #f))
 			 (cond
 			  ;; i.e. this is the parent test to a suite of items, never "run" it
 			  (parent-test
 			   (set! runflag #f))
@@ -391,14 +404,14 @@
 			   (set! runflag #f))
 			  ((and (not (args:get-arg "-rerun"))
 				(member (test:get-status testdat) '("FAIL" "n/a")))
 			   (set! runflag #t))
 			  (else (set! runflag #f)))
-			 ;; (print "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat))
+			 (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat))
 			 (if (not runflag)
 			     (if (not parent-test)
-				 (print "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override"))
+				 (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override"))
 			     (let* ((get-prereqs-cmd (lambda ()
 						       (db-get-prereqs-not-met db run-id waiton))) ;; check before running ....
 				    (launch-cmd      (lambda ()
 						       (launch-test db run-id test-conf keyvallst test-name test-path itemdat)))
 				    (testrundat      (list get-prereqs-cmd launch-cmd)))
@@ -406,20 +419,20 @@
 				       (null? ((car testrundat)))) ;; are there any tests that must be run before this one...
 				   ((cadr testrundat)) ;; this is the line that launches the test to the remote host
 				   (if (not (args:get-arg "-keepgoing"))
 				       (hash-table-set! *waiting-queue* new-test-name testrundat)))))))
 		      ((KILLED) 
-		       (print "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it."))
+		       (debug:print 1 "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it."))
 		      ((LAUNCHED REMOTEHOSTSTART RUNNING)  
 		       (if (> (- (current-seconds)(+ (db:test-get-event_time testdat)
 						     (db:test-get-run_duration testdat)))
 			      100) ;; i.e. no update for more than 100 seconds
 			   (begin
-			     (print "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD")
+			     (debug:print 0 "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD")
 			     (test-set-status! db run-id test-name "INCOMPLETE" "STUCK/DEAD" itemdat "Test is stuck or dead"))
-			   (print "NOTE: " test-name " is already running")))
-		      (else       (print "ERROR: Failed to launch test " new-test-name ". Unrecognised state " (test:get-state testdat))))))
+			   (debug:print 2 "NOTE: " test-name " is already running")))
+		      (else       (debug:print 0 "ERROR: Failed to launch test " new-test-name ". Unrecognised state " (test:get-state testdat))))))
 	      (if (not (null? tal))
 		  (loop (car tal)(cdr tal)))))))))
 
 (define (run-waiting-tests db)
   (let ((numtries           0)
@@ -432,79 +445,88 @@
       (cond
        ((not (runs:can-run-more-tests db))
 	(sleep 2)
 	(loop waiting-test-names))
        ((null? waiting-test-names)
-	(print "All tests launched"))
+	(debug:print 1 "All tests launched"))
        (else
 	(set! numtries (+ numtries 1))
 	(for-each (lambda (testname)
 		    (if (runs:can-run-more-tests db)
 			(let* ((testdat (hash-table-ref *waiting-queue* testname))
 			       (prereqs ((car testdat)))
 			       (ldb     (if db db (open-db))))
-			  ;; (print "prereqs remaining: " prereqs)
+			  (debug:print 2 "prereqs remaining: " prereqs)
 			  (if (null? prereqs)
 			      (begin
-				(print "Prerequisites met, launching " testname)
+				(debug:print 2 "Prerequisites met, launching " testname)
 				((cadr testdat))
 				(hash-table-delete! *waiting-queue* testname)))
 			  (if (not db)
 			      (sqlite3:finalize! ldb)))))
 		  waiting-test-names)
 	;; (sleep 10) ;; no point in rushing things at this stage?
 	(loop (hash-table-keys *waiting-queue*)))))))
 
-(define (get-dir-up-one dir) 
-  (let ((dparts  (string-split dir "/")))
+(define (get-dir-up-n dir . params) 
+  (let ((dparts  (string-split dir "/"))
+	(count   (if (null? params) 1 (car params))))
     (conc "/" (string-intersperse 
-	       (take dparts (- (length dparts) 1))
+	       (take dparts (- (length dparts) count))
 	       "/"))))
 ;; Remove runs
 ;; fields are passing in through 
 (define (runs:remove-runs db runnamepatt testpatt itempatt)
   (let* ((keys        (db-get-keys db))
 	 (rundat      (runs:get-runs-by-patt db keys runnamepatt))
 	 (header      (vector-ref rundat 0))
 	 (runs        (vector-ref rundat 1)))
-    (print "Header: " header)
+    (debug:print 1 "Header: " header)
     (for-each
      (lambda (run)
        (let ((runkey (string-intersperse (map (lambda (k)
 						(db:get-value-by-header run header (vector-ref k 0))) keys) "/")))
 	 (let* ((run-id (db:get-value-by-header run header "id") )
 		(tests  (db-get-tests-for-run db (db:get-value-by-header run header "id") testpatt itempatt))
 		(lasttpath "/does/not/exist/I/hope"))
 	   (if (not (null? tests))
 	       (begin
-		 (print "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
+		 (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
 		 (for-each
 		  (lambda (test)
-		    (print "  " (db:test-get-testname test) " id: " (db:test-get-id test) " " (db:test-get-item-path test))
-		    (db:delete-test-records db (db:test-get-id test))
-		    (if (> (string-length (db:test-get-rundir test)) 5) ;; bad heuristic but should prevent /tmp /home etc.
-			(let ((fullpath (db:test-get-rundir test))) ;; "/" (db:test-get-item-path test))))
-			  (set! lasttpath fullpath)
-			  (print "rm -rf " fullpath)
-			  (system (conc "rm -rf " fullpath))
-			  (let ((cmd (conc "rmdir -p " (get-dir-up-one fullpath))))
-			    (print cmd)
-			    (system cmd))
-			  )))
-		  tests)))
+		    (let* ((item-path (db:test-get-item-path test))
+			   (test-name (db:test-get-testname test))
+			   (run-dir   (db:test-get-rundir test)))
+		      (debug:print 1 "  " (db:test-get-testname test) " id: " (db:test-get-id test) " " item-path)
+		      (db:delete-test-records db (db:test-get-id test))
+		      (if (> (string-length run-dir) 5) ;; bad heuristic but should prevent /tmp /home etc.
+			  (let ((fullpath run-dir)) ;; "/" (db:test-get-item-path test))))
+			    (set! lasttpath fullpath)
+			    (debug:print 1 "rm -rf " fullpath)
+			    (system (conc "rm -rf " fullpath))
+			    (let* ((dirs-count (+ 1 (length keys)(length (string-split item-path "/"))))
+				   (dir-to-rem (get-dir-up-n fullpath dirs-count))
+				   (remainingd (string-substitute (regexp (conc "^" dir-to-rem "/")) "" fullpath))
+				   (cmd (conc "cd " dir-to-rem "; rmdir -p " remainingd )))
+			      (if (file-exists? fullpath)
+				  (begin
+				    (debug:print 1 cmd)
+				    (system cmd)))
+			      ))
+			    )))
+		    tests)))
 	   (let ((remtests (db-get-tests-for-run db (db:get-value-by-header run header "id"))))
 	     (if (null? remtests) ;; no more tests remaining
 		 (let* ((dparts  (string-split lasttpath "/"))
 			(runpath (conc "/" (string-intersperse 
 					    (take dparts (- (length dparts) 1))
 					    "/"))))
-		   (print "Removing run: " runkey " " (db:get-value-by-header run header "runname"))
+		   (debug:print 1 "Removing run: " runkey " " (db:get-value-by-header run header "runname"))
 		   (db:delete-run db run-id)
 		   ;; need to figure out the path to the run dir and remove it if empty
-		;;    (if (null? (glob (conc runpath "/*")))
-		;;        (begin
-		;; 	 (print "Removing run dir " runpath)
-		;; 	 (system (conc "rmdir -p " runpath))))
-		   )))
-		 )))
+		   ;;    (if (null? (glob (conc runpath "/*")))
+		   ;;        (begin
+		   ;; 	 (debug:print 1 "Removing run dir " runpath)
+		   ;; 	 (system (conc "rmdir -p " runpath))))
+		   ))))
+	 ))
      runs)))
-

Index: tests/Makefile
==================================================================
--- tests/Makefile
+++ tests/Makefile
@@ -2,11 +2,11 @@
 
 MEGATEST=$(shell realpath ../megatest)
 
 runall :
 	cd ../;make 
-	$(MEGATEST) -keepgoing -runall :sysname ubuntu :fsname nfs :datapath none :runname `date +%GWW%V.%u` -m "This is a comment specific to a run"
+	$(MEGATEST) -keepgoing -runall :sysname ubuntu :fsname nfs :datapath none :runname `date +%GWW%V.%u` -m "This is a comment specific to a run" -v
 
 test :
 	cd ../;make test
 	make runall
 

Index: tests/megatest.config
==================================================================
--- tests/megatest.config
+++ tests/megatest.config
@@ -27,10 +27,12 @@
 # in the testconfig [pre-launch-env-overrides] section
 [env-override]
 SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs
 TESTVAR [system realpath .]
 DEADVAR [system ls]
+# XTERM   [system xterm]
+# RUNDEAD [system exit 56]
 
 ## disks are:
 ## name host:/path/to/area
 ## -or-
 ## name /path/to/area

Index: tests/tests.scm
==================================================================
--- tests/tests.scm
+++ tests/tests.scm
@@ -21,11 +21,11 @@
 				  (equal? "/tmp" bestdir))))
 
 ;; db
 (define row    (vector "a" "b" "c" "blah"))
 (define header (list "col1" "col2" "col3" "col4"))
-(test "Get row by header" "blah" (db-get-value-by-header row header "col4"))
+(test "Get row by header" "blah" (db:get-value-by-header row header "col4"))
 
 ;; (define *toppath* "tests")
 (define *db* #f)
 (test "setup for run" #t (begin (setup-for-run)
 				(string? (getenv "MT_RUN_AREA_HOME"))))
@@ -52,16 +52,16 @@
 (test "write env files" "nada.csh" (begin
                                       (save-environment-as-files "nada")
                                       (and (file-exists? "nada.sh")
     			                 (file-exists? "nada.csh"))))
 
-(test "get all legal tests" (list "runfirst" "sqlitespeed") (sort (get-all-legal-tests) string<=?))
+(test "get all legal tests" (list "runfirst" "runwithfirst" "singletest" "singletest2" "sqlitespeed") (sort (get-all-legal-tests) string<=?))
 
 (test "register-test, test info" "NOT_STARTED"
       (begin
 	(register-test *db* 1 "nada" "")
-	(test:get-state (runs:get-test-info *db* 1 "nada" ""))))
+	(test:get-state (db:get-test-info *db* 1 "nada" ""))))
 
 (test "get-keys" "sysname" (key:get-fieldname (car (sort (db-get-keys *db*)(lambda (a b)(string>=? (vector-ref a 0)(vector-ref b 0)))))))
 
 (define remargs (args:get-args
 		 '("bar" "foo" ":runname" "bob" ":sysname" "ubuntu" ":fsname" "nfs" ":datapath" "blah/foo" "nada")
@@ -80,6 +80,15 @@
 				    (alist->env-vars prevvals)
 				    result))
 
 (test "env restored" "1234" (get-environment-variable "BLAHFOO"))
 
-				    
+
+(test "Items assoc" "Elephant" (cadar (cadr (item-assoc->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Fall"))))))
+(set! *verbosity* 6)
+(test "Items assoc" '()(item-assoc->item-list '(("a" "a b c d")("b" "c d e")("c" "")("d"))))
+(set! *verbosity* -1)
+(test "Items assoc empty items" '()   (item-assoc->item-list '(("A"))))
+(set! *verbosity* 1)
+(test "Items table" "SEASON" (caadar (item-table->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Winter")))))
+(test "Items table empty items I" '() (item-table->item-list '(("A"))))
+(test "Items table empty items II" '() (item-table->item-list '(("A" ""))))

Index: tests/tests/sqlitespeed/testconfig
==================================================================
--- tests/tests/sqlitespeed/testconfig
+++ tests/tests/sqlitespeed/testconfig
@@ -4,6 +4,7 @@
 [requirements]
 waiton    runfirst
 
 [items]
 MANYITEMS [system (env > envfile.txt;echo aa ab ac ad ae af ag ah ai aj ak al am an ao ap aq ar as at au)]
+# BORKED