Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -2085,10 +2085,19 @@
           sorted)))
      ;; (print "Sorted: " (map simple-run-event_time sorted))
      ;; (print "Remove: " (map simple-run-event_time to-remove))))
      (hash-table-keys runs-ht))
     runs-ht))
+
+(define (remove-last-path-directory path-in)
+  (let* ((dparts  (string-split path-in "/"))
+    (path-out (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))
+    )
+    path-out
+  )
+)
+
 
 ;; (define (runs:remove-all-but-last-n-runs-per-target target-patts runpatt num-to-keep)
 ;;   (let ((data (runs:get-all-but-most-recent-n-per-target target-patts runpatt num-to-keep)))
 ;;     (for-each
 ;;      (lambda (target)
@@ -2154,10 +2163,12 @@
 		(tests     (if (not (equal? run-state "locked"))
 			       (proc-get-tests run-id)
 			       '()))
 		(lasttpath "/does/not/exist/I/hope")
 		(lastrealpath "/does/not/exist/I/hope")
+                ;; there may be a number of different disks used in the same run.
+                (run-paths-hash (make-hash-table))
 		(worker-thread #f))
 	   (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header)
 	   (if (not (null? tests))
 	       (begin
 		 (case action
@@ -2336,20 +2347,34 @@
                                         ;; NOTE: This is suboptimal as the testdata will be used later and the state/status may have changed ...
                                         (if (null? tal)
                                             (loop new-test-dat tal)
                                             (loop (car tal)(append tal (list new-test-dat)))))
                                       (begin
-                                        (if (and (not (string=  (db:test-get-rundir new-test-dat) "/tmp/badname")) (file-exists? (db:test-get-rundir new-test-dat)))
+                                       (let ((rundir (db:test-get-rundir new-test-dat)))
+                                        (if (and (not (string=  rundir "/tmp/badname")) 
+                                             (file-exists? rundir)
+                                             (substring-index run-name rundir)
+                                             (substring-index target rundir)
+                                             )
                                           (begin
                                             (set! lasttpath (db:test-get-rundir new-test-dat)) ;; remember this path for run removal
-                                            (set! lastrealpath (resolve-pathname lasttpath))
+                                            (set! lastrealpath (remove-last-path-directory (resolve-pathname lasttpath)))
+                                            (hash-table-set! run-paths-hash lastrealpath 1)
                                             (runs:remove-test-directory new-test-dat mode) ;; 'remove-all)
                                           )
+                                          (begin
+                                            (debug:print 2 *default-log-port* "Not removing directory " rundir " because either it doesn't exist or has a bad name")
+                                            (debug:print 2 *default-log-port* "Is /tmp/badname: " (string=  rundir "/tmp/badname"))
+                                            (debug:print 2 *default-log-port* "Exists: " (file-exists? rundir))
+                                            (debug:print 2 *default-log-port* "Has run-name: " (substring-index run-name rundir))
+                                            (debug:print 2 *default-log-port* "Has target: " (substring-index target rundir))
+                                          )
                                         )
+                                      )
 
-                                        (if (not (null? tal))
-                                            (loop (car tal)(cdr tal)))))))
+                                      (if (not (null? tal))
+                                         (loop (car tal)(cdr tal)))))))
 				(rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
                                ((kill-runs)
                                 ;; RUNNING -> KILLREQ
                                 ;; LAUNCHED,RUNNING,REMOTEHOSTSTART -> NOT STARTED
                                 (cond
@@ -2421,32 +2446,32 @@
 	   ;; remove the run if zero tests remain
 	   (if (eq? action 'remove-runs)
 	       (let* ((run-id   (db:get-value-by-header run header "id")) ;; NB// masks run-id from above?
                       (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t)))
 		 (if (null? remtests) ;; no more tests remaining
-
-         ;; Remove the last dir from the path.
-         ;; And same for the link-resolved path
-		     (let* ((dparts  (string-split lasttpath "/"))
-			      (linkspath (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))
-            (real-dparts (string-split lastrealpath "/"))
-			      (realpath (conc "/" (string-intersperse (take real-dparts (- (length real-dparts) 1)) "/")))
-            )
-
-            (debug:print 1 *default-log-port* "Removing run: " linkspath)
-            (if (not keep-records)
-               (begin
-                 (debug:print 1 *default-log-port* "Removing DB records for the run.")
-                 (rmt:delete-run run-id)
-                 (rmt:delete-old-deleted-test-records))
-            )
-	          (debug:print 1 *default-log-port* "Recursively removing links dir " linkspath)
-            (runs:recursive-delete-with-error-msg linkspath)
-
-            (debug:print 1 *default-log-port* "Recursively removing real dir " realpath)
-            (runs:recursive-delete-with-error-msg realpath)
-
+	           (let* ((linkspath (remove-last-path-directory lasttpath))
+                          (runpaths (hash-table-keys run-paths-hash))
+                    )
+
+                    (debug:print 2 *default-log-port* "run-paths-hash: " (hash-table-keys run-paths-hash))
+
+                    (debug:print 1 *default-log-port* "Removing target " target "run: " run-name)
+                    (if (not keep-records)
+                      (begin
+                        (debug:print 1 *default-log-port* "Removing DB records for the run.")
+                        (rmt:delete-run run-id)
+                        (rmt:delete-old-deleted-test-records))
+                    )
+	           (debug:print 1 *default-log-port* "Recursively removing links dir " linkspath)
+                   (runs:recursive-delete-with-error-msg linkspath)
+
+                   (for-each (lambda(runpath)
+                       (debug:print 1 *default-log-port* "Recursively removing runs dir " runpath)
+                       (runs:recursive-delete-with-error-msg runpath)
+                     )
+                     runpaths
+                   )
 		       )))))
 	 ))
      runs)
     ;; special case - archive get
     (if (equal? (args:get-arg "-archive") "get")