ADDED   dfs.scm
Index: dfs.scm
==================================================================
--- /dev/null
+++ dfs.scm
@@ -0,0 +1,241 @@
+
+(use extras)
+(use data-structures)
+(use srfi-1)
+(use regex)
+
+
+(define (tests:get-test-property test-registry test property)
+  (let loop ((rem-test-registry test-registry) (res #f))
+    (if (null? rem-test-registry)
+        res
+        (let* ((this-test (car rem-test-registry))
+              (this-testname (car this-test))
+              (this-testrec (cdr this-test)))
+          (if (eq? this-testname test)
+              (alist-ref property this-testrec)
+              (loop (cdr rem-test-registry) res))))))
+
+(define (tests:get-test-waitons test-registry test)
+  (tests:get-test-property test-registry test 'waitons))
+
+(define (tests:get-test-list test-registry)
+  (map car test-registry))
+
+
+(define (alist-push alist key val)
+  (let ((current (alist-ref key alist)))
+    (if current
+        (alist-update key (cons val current) alist)
+        (cons (list key val) alist))))
+
+  
+(define (test:get-adj-list test-registry)
+  (let loop ((rem-tests (tests:get-test-list test-registry)) (res '()))
+    (if (null? rem-tests)
+        res
+        (let* ((test (car rem-tests))
+               (rest-rem-tests (cdr rem-tests))
+               (waitons
+                (or
+                 (tests:get-test-waitons test-registry test)
+                 '())))
+          (loop rest-rem-tests
+                (let loop2 ((rem-waitons waitons) (res2 res))
+                  (if (null? rem-waitons)
+                      res2
+                      (let* ((waiton (car rem-waitons))
+                             (rest-waitons (cdr rem-waitons))
+                             (next-res (alist-push res2 waiton test)))
+                        (loop2 rest-waitons next-res)))))))))
+
+
+
+(define (add-item-to-items-list item items)
+  (cond
+   ((eq? item '%) 
+    (list '%))
+   ((member '% items) (print "% in items")
+    (list '%))
+   ((member item items) 
+    items)
+   (else
+    (cons item items))))
+
+(define (append-items-lists l1 l2)
+  (let loop ((rem-l1 l1) (res l2))
+    (if (null? rem-l1)
+        res
+        (let* ((hed-rem-l1 (car rem-l1))
+               (tal-rem-l1 (cdr rem-l1))
+               (new-res (add-item-to-items-list hed-rem-l1 res)))
+          (loop tal-rem-l1 new-res)))))
+
+
+(define (testpatt->alist testpatt)
+  (if (string? testpatt)
+      (let ((patts (string-split testpatt ",")))
+        (if (null? patts) ;;; no pattern(s) means no match
+            #f
+            (let loop ((rest-patts patts) (res  '()))
+              ;; (print "loop: patt: " patt ", tal " tal)
+              (if (null? rest-patts)
+                  res
+                  (let* ((hed-patt (car rest-patts))
+                         (tal-rest-patts (cdr rest-patts))
+                         (patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") hed-patt))
+                         (test (string->symbol (cadr patt-parts)))
+                         (item-patt-raw  (cadddr patt-parts))
+                         (item-patt
+                          (if item-patt-raw
+                              (string->symbol item-patt-raw)
+                              '%))
+                         (existing-item-patts (or (alist-ref test res) '()))
+                         (new-item-patts (add-item-to-items-list item-patt existing-item-patts))
+                         (new-res (alist-update test new-item-patts res)))
+                    (print "BB->: test="test" item-patt-raw="item-patt-raw" item-patt="item-patt" existing-item-patts="existing-item-patts" new-item-patts="new-item-patts)
+                    (loop tal-rest-patts new-res))))))))
+
+(define (traverse node adj-list path)
+  ;(print "node="node" path="path)
+  (let ((children (alist-ref node adj-list)))
+    (cond
+     ((not children)  (list (cons node path)))
+     (else
+      (apply append
+             (map
+              (lambda (child)
+                (traverse child adj-list (cons node path)))
+              children))))))
+
+(define test-registry
+  '(
+    (aa . ( (items . ( 1 2 3 )) ))
+    (a  . ( (items . ( 1 2 3 )) ))
+    (b  . ( (items . ( 1 2 3 ))
+           (waitons . (a)   ) ) )
+    (c  . ( (items . ( 1 2 3 ))
+           (waitons . (a)   ) ) )
+    (f  . ( (items . ( 1 2 3 ))
+           (waitons . (a)   ) ) )
+    (d  . ( (items . ( 1 2 3 ))
+           (waitons . (b c) ) ) )
+    (g  . ( (items . ( 1 2 3 ))
+           (waitons . (b)   ) ) )
+    (e  . ( (items . ( 1 2 3 ))
+           (waitons . (d)   ) ) )
+    (h  . ( (items . ( 1 2 3 ))
+           (waitons . (d)   ) ) )
+       ))
+
+(set! test-registry2
+      (cons
+       (cons 'ALL-TESTS (list (cons 'waitons (tests:get-test-list test-registry))))
+       test-registry))
+
+
+
+(pretty-print test-registry)
+(define adj-list (test:get-adj-list test-registry))
+
+(print "adjacency list=")(pretty-print adj-list)
+
+(print "topological-sort=" (topological-sort adj-list eq?))
+
+(define seed-testpatt "a/1,a/2,d,aa/%")
+(define seed-testpatt-alist (testpatt->alist seed-testpatt))
+
+;;(define seed-tests '(d aa))
+(define seed-tests (map car seed-testpatt-alist))
+(print "seed-testpatt="seed-testpatt"\n** seed-testpatt-alist="seed-testpatt-alist"\n seed-tests="seed-tests)
+
+(define waiton-paths
+  (map
+   reverse
+   (apply append
+          (map
+           (lambda (test)
+             (traverse test adj-list '())) seed-tests))))
+       
+
+(print "waiton-paths=")
+(pretty-print waiton-paths)  
+
+
+(define (get-waiton-items parent-test parent-item-patterns waiton-test test-registry)
+  (let* ((parent-item->waiton-item (lambda (x) x)) ;; super simplified vs. megatest, should use itemmap property
+         (waiton-test-items (or (tests:get-test-property test-registry waiton-test 'items) '(%)))
+         )
+    (let loop ((rest-parent-item-patterns parent-item-patterns) (res '()))
+      (if (null? rest-parent-item-patterns)
+          res
+          (let* ((hed-parent-item (car rest-parent-item-patterns))
+                 (tal-parent-items (cdr rest-parent-item-patterns))
+                 (newres (add-item-to-items-list (parent-item->waiton-item hed-parent-item) res)))
+            (loop tal-parent-items newres))))))
+   
+(define (push-itempatt-down-path waiton-path seed-items test-registry )
+  (let loop ((rest-path waiton-path) (waiton-items seed-items) (res '())  )
+    (if (null? rest-path)
+        res
+        (let* ((hed-test (car rest-path))
+               (tal-path (cdr rest-path))
+               (waiton-test (car rest-path))
+               (waiton-items (get-waiton-items hed-test waiton-items waiton-test test-registry))
+               (new-res (cons (cons waiton-test waiton-items) res)))
+                 
+          (loop tal-path waiton-items new-res)))))
+               
+(print "testpatts from first path="(car waiton-paths))
+
+(define (condense-alist alist)
+  (let loop ((rest-alist alist) (res '()))
+    (if (null? rest-alist)
+        res
+        (let* ((hed-alist (car rest-alist))
+               (tal-alist (cdr rest-alist))
+               (key (car hed-alist))
+               (new-items (cdr hed-alist))
+               (existing-list (alist-ref key res))
+               (new-list
+                (if existing-list
+                    (append-items-lists new-items existing-list)
+                    new-items
+                    ))
+               (new-res (alist-update key new-list res)))
+          (loop tal-alist new-res)))))
+               
+                    
+
+(define (get-elaborated-testpatt-alist waiton-paths seed-testpatt-alist test-registry)
+  (let ((raw-res
+         (let loop ((rest-waiton-paths waiton-paths) (res '()))
+           (if (null? rest-waiton-paths)
+               res
+               (let* ((hed-path (car rest-waiton-paths))
+                      (tal-paths (cdr rest-waiton-paths))
+                      (test (car hed-path))
+                      (items (alist-ref test seed-testpatt-alist))
+                      (new-res (cons (push-itempatt-down-path hed-path items test-registry) res))
+                      
+                      
+                      )
+                 (loop tal-paths new-res))))))
+    (condense-alist raw-res)))
+        
+
+
+(pretty-print
+ (get-elaborated-testpatt-alist waiton-paths seed-testpatt-alist test-registry))
+
+
+
+
+
+
+
+
+
+
+  
+

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -237,11 +237,11 @@
 ;;            
 (define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names
   (let* ((keys               (keys:config-get-fields *configdat*))
 	 (keyvals            (keys:target->keyval keys target))
 	 (run-id             (rmt:register-run keyvals runname "new" "n/a" user))  ;;  test-name)))
-	 (deferred          '()) ;; delay running these since they have a waiton clause
+	 (deferred          '()) ;; delay running these since they have a waiton clause (never used - BB)
 	 (runconfigf         (conc  *toppath* "/runconfigs.config"))
 	 (test-records       (make-hash-table))
 	 ;; need to process runconfigs before generating these lists
 	 (all-tests-registry #f)  ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
 	 (all-test-names     #f)  ;; (hash-table-keys all-tests-registry))
@@ -249,11 +249,11 @@
 	 (required-tests     #f)  ;; Put fully qualified test/testpath names in this list to be done
 	 (task-key           (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
 	 (tdbdat             (tasks:open-db))
 	 (config-reruns      (let ((x (configf:lookup *configdat* "setup" "reruns")))
 			       (if x (string->number x) #f))))
-
+    (debug:print-info 0 "BB------------------------------------------------\nBB: entered run:run-tests with target="target" runname="runname" test-patts="test-patts" user="user" flags="flags" run-count="run-count)
     ;; override the number of reruns from the configs
     (if (and config-reruns
 	     (> run-count config-reruns))
 	(set! run-count config-reruns))
     
@@ -357,12 +357,14 @@
     ;; What happended, this code is now duplicated in tests!?
     ;;
     ;;======================================================================
     
     (if (not (null? test-names))
-	(let loop ((hed (car test-names))
+	(let loop ((processed '())
+                   (hed (car test-names))
 		   (tal (cdr test-names)))         ;; 'return-procs tells the config reader to prep running system but return a proc
+          (debug:print-info 0 "BB: +++LOOP (iter="(counter 'rtloop)")  test-patts="test-patts" hed="hed" tal="tal)
 	  (change-directory *toppath*) ;; PLEASE OPTIMIZE ME!!! I think this should be a no-op but there are several places where change-directories could be happening.
 	  (setenv "MT_TEST_NAME" hed) ;; 
 	  (let*-values (((waitons waitors config)(tests:get-waitons hed all-tests-registry)))
 	    (debug:print-info 8 "waitons: " waitons)
 	    ;; check for hed in waitons => this would be circular, remove it and issue an
@@ -374,11 +376,13 @@
 		  (set! waitons (filter (lambda (x)(not (equal? x hed))) waitons))
 		  (set! waitors (filter (lambda (x)(not (equal? x hed))) waitors))))
 	    
 	    ;; (items   (items:get-items-from-config config)))
 	    (if (not (hash-table-ref/default test-records hed #f))
-		(hash-table-set! test-records
+		(begin
+                  (debug:print-info 0 "BB: HASH ADD "hed" whose waitors are >"waitors"<")
+                  (hash-table-set! test-records  ;; BB: here we add record to hash table
 				 hed (vector hed     ;; 0
 					     config  ;; 1
 					     waitons ;; 2
 					     (config-lookup config "requirements" "priority")     ;; priority 3
 					     (let ((items      (hash-table-ref/default config "items" #f)) ;; items 4
@@ -387,11 +391,11 @@
 					       ;; process can know to call items:get-items-from-config
 					       ;; if either is a list and none is a proc go ahead and call get-items
 					       ;; otherwise return #f - this is not an iterated test
 					       (cond
 						((procedure? items)      
-						 (debug:print-info 4 "items is a procedure, will calc later") ;; BB? calc later? when??
+						 (debug:print-info 4 "items is a procedure, will calc later") ;; BB? calc later? when?? why not now?
 						 items)            ;; calc later
 						((procedure? itemstable)
 						 (debug:print-info 4 "itemstable is a procedure, will calc later")
 						 itemstable)       ;; calc later
 						((filter (lambda (x)
@@ -406,21 +410,24 @@
 						 (items:get-items-from-config config))
 						(else #f)))                           ;; not iterated
 					     #f      ;; itemsdat 5
 					     #f      ;; spare - used for item-path
 					     waitors ;; 
-					     )))
+					     ))))
+            (debug:print-info 0 "BB: iterating over waitons+waitors -> waitons="waitons" waitors="waitors)
 	    (for-each 
 	     (lambda (waiton)
+               (debug:print-info 0 "BB:   - visiting "waiton)
 	       (if (and waiton (not (member waiton test-names)))
 		   (let* ((waiton-record   (hash-table-ref/default test-records waiton #f))
 			  (waiton-tconfig  (if waiton-record (vector-ref waiton-record 1) #f))
 			  (waiton-itemized (and waiton-tconfig
 						(or (hash-table-ref/default waiton-tconfig "items" #f)
 						    (hash-table-ref/default waiton-tconfig "itemstable" #f))))
 			  (itemmaps        (tests:get-itemmaps config));; (configf:lookup config "requirements" "itemmap"))
 			  (new-test-patts  (tests:extend-test-patts test-patts hed waiton itemmaps)))
+                     (debug:print-info 0 "BB: HASH REF "waiton" (waiton)")
 		     (debug:print-info 0 "Test " waiton " has " (if waiton-record "a" "no") " waiton-record and" (if waiton-itemized " " " no ") "items")
 		     ;; need to account for test-patt here, if I am test "a", selected with a test-patt of "hed/b%"
 		     ;; and we are waiting on "waiton" we need to add "waiton/,waiton/b%" to test-patt
 		     ;; is this satisfied by merely appending "/" to the waiton name added to the list?
 		     ;;
@@ -429,40 +436,78 @@
 		     ;; if we have this waiton already processed once we can analzye it for extending
 		     ;; tests to be run, since we can't properly process waitons unless they have been
 		     ;; initially added we add them again to be processed on second round AND add the hed
 		     ;; back in to also be processed on second round
 		     ;;
-		     (if waiton-tconfig
+		     (if waiton-tconfig ;; will be false if waiton record has not been added to hash yet
 			 (begin
+
 			   (set! test-names (cons waiton test-names)) ;; need to process this one, only add once the waiton tconfig read
 			   (if waiton-itemized
 			       (begin
 				 (debug:print-info 0 "New test patts: " new-test-patts ", prev test patts: " test-patts)
 				 (set! required-tests (cons (conc waiton "/") required-tests))
-				 (set! test-patts new-test-patts))
+                                 (debug:print-info 0 "!!! BB !!! waiton *is* itemized accepted new-test-patts->test-patts: "new-test-patts)
+				 (set! test-patts new-test-patts)
+                                 (set! processed (cons hed processed))
+                                 )
 			       (begin
 				 (debug:print-info 0 "Adding non-itemized test " waiton " to required-tests")
 				 (set! required-tests (cons waiton required-tests))
-				 (set! test-patts new-test-patts))))
+                                 (debug:print-info 0 "!!! BB !!! waiton NOT itemized accepted new-test-patts->test-patts: "new-test-patts)
+				 (set! test-patts new-test-patts)
+                                 (set! processed (cons hed processed))
+                                 )))
 			 (begin
-			   (debug:print-info 0 "No testconfig info yet for " waiton ", setting up to re-process it")
-			   (set! tal (append (cons waiton tal)(list hed))))) ;; (cons (conc waiton "/") required-tests))
+			   (debug:print-info 0 "No testconfig info yet for " waiton ", setting up to re-process it even though new-test-patt is >"new-test-patts"<")
+
+                           ;; BB: by pushing upstream test with item
+                           ;; filter to end, downstream tests' items
+                           ;; are not filtered when encountered.  This
+                           ;; causes chained-waiton/item_seq4 to FAIL.
+                           ;; when test3/%, test2/%, test1/% all items
+                           ;; are added to testpatt when instead
+                           ;; test4/item.1 should imply test3/item.1,
+                           ;; which shold imply test2/item.1 and so on
+                           (debug:print-info 0 "BB: pushing "hed" to back of the line")
+                           (debug:print-info 0 "BB: new tal = waiton,tal + hed = "waiton","tal" + "hed)
+                           
+                           (set! tal (append (cons waiton tal)(list hed))))) ;; (cons (conc waiton "/") required-tests)) ;; BB- EXAMINE
                      
 		     ;; NOPE: didn't work. required needs to be plain test names. Try tacking on to test-patts
 		     ;;  - doesn't work
 		     ;; (set! test-patts (conc test-patts "," waiton "/"))
 		     
 		     ;; (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
-		     )))
+		     ))
+               (debug:print-info 0 "BB:   - leaving "waiton)
+               )
 	     (delete-duplicates (append waitons waitors)))
-	    (let ((remtests (delete-duplicates (append waitons tal))))
+            (debug:print-info 0 "BB: done iterating over waitons+waitors -> waitons="waitons" waitors="waitors)
+	    (let ((remtests (delete-duplicates (append waitons tal)))) ;; BB EXAMINE
 	      (if (not (null? remtests))
-		  (begin ;; BB: by pushing upstream test with item filter to end, downstream tests' items are not filtered when encountered.  This causes chained-waiton/item_seq4 to FAIL.
-                    ;;          when test3/%, test2/%, test1/% all items are added to testpatt when instead test4/item.1 should imply test3/item.1, which shold imply test2/item.1 and so on
+		  (begin 
+                    
 		    (debug:print-info 0 "Preprocessing continues for " (string-intersperse remtests ", "))
-		    (loop (car remtests)(cdr remtests))))))))
+                    ;; BB: remtest must be in topological order of waiton edges
+                    (let* (
+                           (filtered-remtests (filter (lambda (x) (not (member x processed))) remtests))
+                           (new-hed (car filtered-remtests))
+                           (method (string->symbol (or (get-environment-variable "DEPSORTMETHOD") "new"))) ;; setenv DEPSORTMETHOD old to go back
+                           (new-tal
+                            (if (eq? method 'old)
+                                (cdr filtered-remtests)
+                                (runs:toposort (cdr filtered-remtests) all-tests-registry))))
+                      ;;(set! remtests (runs:toposort remtests all-tests-registry))
+                      ;;(loop (car remtests)(cdr remtests))
+                      (loop processed new-hed new-tal)
+                    )))))))
 
+
+    
+    (counter-reset 'rtloop)
+    (debug:print-info 0 "BB: Finished elaboration of waiton dependencies (maybe?)")
     (if (not (null? required-tests))
 	(debug:print-info 0 "BB Adding \"" (string-intersperse required-tests " ") "\" to the run queue")) ; BB changed 1 to 0
     ;; NOTE: these are all parent tests, items are not expanded yet.
     (debug:print-info 0 "BB test-records=" (hash-table->alist test-records)) ; BB: changed 4 to 0
     (let ((reglen (configf:lookup *configdat* "setup" "runqueue")))
@@ -509,10 +554,142 @@
 	  (debug:print-info 0 "No tests to run")))
     (debug:print-info 4 "All done by here")
     (rmt:tasks-set-state-given-param-key task-key "done")
     ;; (sqlite3:finalize! tasks-db)
     ))
+
+;; define custom counters -- very handy to line up iteration of debug message calls within a single execution
+(define *counter-alist* (make-parameter '()))
+(define (counter key)
+  (let* ((counter-param
+         (or
+          (alist-ref (->string key) (*counter-alist*) equal?)
+          (let ((new-counter (make-parameter 0)))
+            (*counter-alist* (cons (cons (->string key) new-counter) (*counter-alist*)))
+            new-counter)))
+         (current-count (counter-param))
+         (new-count (add1 current-count)))
+    (counter-param new-count)))
+
+(define (counter-reset key)
+  (let ((existing-counter (alist-ref (->string key) (*counter-alist*) equal?)))
+    (if existing-counter
+        (existing-counter 0)
+        (counter key))))
+        
+          
+;; BAD HACK follows.
+;; on initial pass thru, adjacency-list is correct.  later, somehow waitons get corrupted (eg. EVERYTHING depends on test3.. whY?
+;; the hack - cache initial adjacency-list  (hopefully alltests cannot change midstream or the static analysis is otherwise invalidated!!)
+;; good god, *cached-adjacency-list* changes over time.  Should be constant! wtf?, disabling cache.
+
+
+(define *cached-adjacency-list* (make-parameter #f))
+
+;; (define (runs:get-itemmaps all-tests-registry)
+;;   (let* ((full-adjacency-list
+;;          (map
+;;           (lambda (test)
+;;             (let*-values (((waitons waitors config) (tests:get-waitons test all-tests-registry)))
+;;               (debug:print-info 0 "    BB: test="test" waitons="waitons" waitors="waitors)
+;;               (cons test (append waitons waitors))))))))
+
+;; ;(hash-table-ref all-tests-registry test-name))
+  
+;;   )
+  
+
+(define (runs:get-test-adjacency-list all-tests-registry testlist-filter )
+  ;; on first pass, initialize cache with adjacency-list for all tests 
+  (when (or #t (not (*cached-adjacency-list*))) ;; or #t forces eval every time
+      (let* ((alltestlist (hash-table-keys (tests:get-all)))
+             (full-adjacency-list
+                (map
+                 (lambda (test)
+                   (let*-values (((waitons waitors config) (tests:get-waitons test all-tests-registry)))
+                     (debug:print-info 0 "    BB: test="test" waitons="waitons" waitors="waitors)
+                     (cons test (append waitons waitors))))
+                 ;;testlist-filter))
+                 alltestlist))
+             (sorted-alltestlist (sort alltestlist (lambda (a b) (string< (->string a) (->string b))))))
+        (debug:print-info 0 "--=> BB: ALLTESTLIST iter="(counter 'alltestlist)"  val="sorted-alltestlist)
+
+        (debug:print-info 0 "--=> BB: initialized *cached-adjacency-list* with "
+                          full-adjacency-list)
+        (*cached-adjacency-list* full-adjacency-list)))
+
+  ;; return adjacency-list only containing tests in testlist-filter
+  (let* ((full-adjacency-list (*cached-adjacency-list*))
+         ;; trim list - 1) remove any toplevel list whose car is not a member of testlist-filter
+         ;;             2) remove all items from cdr which is not a member of testlist-filter
+         ;;             3) shouldn't happen, but remove any from cdr which matches car
+         (trimmed-list-1 (filter
+                          (lambda (row)
+                            (member (car row) testlist-filter))
+                          full-adjacency-list))
+         (trimmed-list-2 (map
+                          (lambda (row)
+                            (filter
+                             (lambda (field)
+                               (member field testlist-filter))
+                             row))
+                          trimmed-list-1))
+         (trimmed-list-3 (map
+                          (lambda (row)
+                            (let ((hed (car row)) (tal (cdr row)))
+                              (cons hed
+                                    (filter
+                                     (lambda (field)
+                                       (not (equal? field hed)))
+                                     tal))))
+                          trimmed-list-2))
+         (adjacency-list trimmed-list-3))
+    (debug:print-info 0 "      BB full-adjacency-list="full-adjacency-list)
+    (debug:print-info 0 "      BB trimmed-list-1"trimmed-list-1)
+    (debug:print-info 0 "      BB trimmed-list-2"trimmed-list-2)
+    (debug:print-info 0 "      BB trimmed-list-3"trimmed-list-3)
+    (debug:print-info 0 "     BB entered with testlist-filter="testlist-filter)
+    adjacency-list))
+        
+
+(define (toposort-check testlist sortedlist)
+  (let* ((normalize-list (lambda (the-list) (sort the-list (lambda (a b) (string< (->string a) (->string b))))))
+         (normal-testlist (normalize-list testlist))
+         (normal-sortedlist (normalize-list sortedlist))
+         (OK  (cond
+               ((not (= (length normal-testlist) (length normal-sortedlist)))
+                (debug:print-info 0 "BB: TOPOSORT-CHECK FAILED.  length["testlist"] != length["sortedlist"]")
+                #f)
+               ((not (equal? normal-testlist normal-sortedlist))
+                (debug:print-info 0 "BB: TOPOSORT-CHECK FAILED.  members["testlist"] != members["sortedlist"]")
+                #f)
+               (else
+               (debug:print-info 0 "BB: TOPOSORT-CHECK :) PASS :)")))))
+
+    
+    OK))
+    
+          
+(define (runs:toposort testlist all-tests-registry)
+  ;(print "ALL-TESTS-REGISTRY")
+  
+  ;(pretty-print (hash-table->alist all-tests-registry))
+  ;(exit 1)
+    
+
+  (let* ((adjacency-list (runs:get-test-adjacency-list all-tests-registry testlist)))
+    (debug:print-info 0 "BB> adjacency-list("testlist") = "adjacency-list)
+    (let ((sorted-list
+           (topological-sort adjacency-list equal?)))
+      (debug:print-info 0 "BB> sorted-list("testlist") = "sorted-list)
+      (let* ((filtered-sorted-list
+             (filter (lambda (item) (member item testlist)) sorted-list))
+             (res filtered-sorted-list))
+        (debug:print-info 0 "BB> TOPOSORT-*"(counter res)"*-       "testlist" ==**==> " filtered-sorted-list)
+        (toposort-check testlist res)
+        res
+        ))))
 
 
 ;; loop logic. These are used in runs:run-tests-queue to make it a bit more readable.
 ;;
 ;; If reg not full and have items in tal then loop with (car tal)(cdr tal) reg reruns

Index: tests.scm
==================================================================
--- tests.scm
+++ tests.scm
@@ -121,30 +121,32 @@
 			(debug:print 0 "ERROR: non-existent required test \"" test-name "\"")
 			(exit 1))))
 	   (instr2 (if config
 		       (config-lookup config "requirements" "waitor")
 		       "")))
-       (debug:print-info 8 "waitons string is " instr ", waitors string is " instr2)
+       (debug:print-info 0 "BB: RAW waiton("test-name") is >" instr "<, waitors string is >" instr2"<") ; BB 8 to 0
        (let ((newwaitons
 	      (string-split (cond
 			     ((procedure? instr)
 			      (let ((res (instr)))
-				(debug:print-info 8 "waiton procedure results in string " res " for test " test-name)
+				(debug:print-info 0 "waiton procedure results in string " res " for test " test-name) ; BB changed from 8 to 0
 				res))
 			     ((string? instr)     instr)
 			     (else 
-			      ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 "ERROR: something went wrong in processing waitons for test " test-name)
+			      ;; NOTE: This is actually the case of *no* waitons!
+                              (debug:print 0 "BB: ERROR: something went wrong in processing waitons for test " test-name) ;; BB: uncommented.
 			      ""))))
 	     (newwaitors
 	      (string-split (cond
 			     ((procedure? instr2)
 			      (let ((res (instr2)))
 				(debug:print-info 8 "waitor procedure results in string " res " for test " test-name)
 				res))
 			     ((string? instr2)     instr2)
 			     (else 
-			      ;; NOTE: This is actually the case of *no* waitons! ;; (debug:print 0 "ERROR: something went wrong in processing waitons for test " test-name)
+			      ;; NOTE: This is actually the case of *no* waitors! ;; BB: WRONG.  This seems to be the case of ALL waitors.
+                              ;;(debug:print 0 "BB: ERROR: something went wrong in processing waitors for test " test-name) ; BB: uncommented/recommented
 			      "")))))
 	 (values
 	  ;; the waitons
 	  (filter (lambda (x)
 		    (if (hash-table-ref/default all-tests-registry x #f)
@@ -155,11 +157,11 @@
 		  newwaitons)
 	  (filter (lambda (x)
 		    (if (hash-table-ref/default all-tests-registry x #f)
 			#t
 			(begin
-			  (debug:print 0 "ERROR: test " test-name " has unrecognised waiton testname " x)
+			  (debug:print 0 "ERROR: test " test-name " has unrecognised waitor testname " x)
 			  #f)))
 		  newwaitors)
 	  config)))))
 					     
 ;; given waiting-test that is waiting on waiton-test extend test-patt appropriately
@@ -172,10 +174,12 @@
 ;;                                  # trim off the cell to determine what to run for genlib
 ;;                                  itemmap /.*
 ;;
 ;;                                  waiting-test is waiting on waiton-test so we need to create a pattern for waiton-test given waiting-test and itemmap
 (define (tests:extend-test-patts test-patt waiting-test waiton-test itemmaps)
+
+  (debug:print-info 0 "BB: iter="(counter test-patt)" test:extend-test-patts entered with test-patt="test-patt" waiting-test="waiting-test" waiton-test="waiton-test" itemmaps="itemmaps)
   (let* ((itemmap          (tests:lookup-itemmap itemmaps waiton-test))
 	 (patts            (string-split test-patt ","))
 	 (waiting-test-len (+ (string-length waiting-test) 1))
 	 (patts-waiton     (map (lambda (x)  ;; for each incoming patt that matches the waiting test
 				  (let* ((modpatt (if itemmap (db:convert-test-itempath x itemmap) x)) 
@@ -185,14 +189,21 @@
 				    newpatt))
 				(filter (lambda (x)
 					  (eq? (substring-index (conc waiting-test "/") x) 0)) ;; is this patt pertinent to the waiting test
 					patts))))
 
-    (string-intersperse (delete-duplicates (append patts (if (null? patts-waiton)
-							     (list (conc waiton-test "/%")) ;; really shouldn't add the waiton forcefully like this
-							     patts-waiton)))
-			",")))
+    (let ((res
+           (string-intersperse
+            (delete-duplicates
+             (append
+              patts
+              (if (null? patts-waiton)
+                  (list (conc waiton-test "/%")) ;; really shouldn't add the waiton forcefully like this
+                  patts-waiton)))
+            ",")))
+      (debug:print-info 0 "BB: test:extend-test-patts returns "res)
+      res)))
   
 ;; tests:glob-like-match 
 (define (tests:glob-like-match patt str) 
   (let ((like (substring-index "%" patt)))
     (let* ((notpatt  (equal? (substring-index "~" patt) 0))