From 392b81aa06dd22231bf4c960eb7b75a64e228437 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@iu.edu>
Date: Mon, 19 Oct 2026 10:28:30 -0400
Subject: [PATCH] Read test-xvfb-paths from ancestor info.rkt files

path-needs-xvfb? read only the info.rkt in a test's own directory, so a
test listed by an ancestor's info.rkt ran under xvfb-run only if DrDr
had already read that info.rkt. DrDr visits a directory's tests
subdirectory first, so the BC run of gui-test's
framework/tests/group-test.rkt always used the shared display. Like
raco test does for test-omit-paths, path-needs-xvfb? now reads every
info.rkt from the test's directory up to the trunk.
---
 plt-build.rkt                    | 49 +++++++++++++++++++++-----------
 tests/xvfb/info.rkt              |  3 +-
 tests/xvfb/nested/listed.rkt     |  2 ++
 tests/xvfb/nested/unlisted.rkt   |  2 ++
 tests/xvfb/tests/deeper/deep.rkt |  2 ++
 5 files changed, 41 insertions(+), 17 deletions(-)
 create mode 100644 tests/xvfb/nested/listed.rkt
 create mode 100644 tests/xvfb/nested/unlisted.rkt
 create mode 100644 tests/xvfb/tests/deeper/deep.rkt

diff --git a/plt-build.rkt b/plt-build.rkt
index 978ea9c..2a40690 100644
--- a/plt-build.rkt
+++ b/plt-build.rkt
@@ -43,15 +43,21 @@
                                       p))
                        (hash-set! xvfb-paths dp #t)))))))))
 
+;; Reports whether the test at `pth` runs under xvfb-run. An info.rkt in any
+;; directory from the test's own up to `trunk-dir` can list the test, or a
+;; directory containing it, in test-xvfb-paths; DrDr may reach the test
+;; before it reaches that info.rkt, so read them all here.
 (define (path-needs-xvfb? pth trunk-dir)
-  (define-values (base name dir?) (split-path pth))
-  (define dir (if (path? base) (path->complete-path base) (current-directory)))
-  (check-xvfb-info dir)
-  (let ([p (normalize-info-path pth)])
-    (or (hash-ref xvfb-paths p #f)
-        (let-values ([(base name dir?) (split-path p)])
-          (and (path? base)
-               (hash-ref xvfb-paths base #f))))))
+  (define p (normalize-info-path pth))
+  (define top (path->directory-path (normalize-info-path trunk-dir)))
+  (define rel (explode-path (find-relative-path top p)))
+  (define ancestors
+    (for/list ([i (in-range (length rel))])
+      (path->directory-path (apply build-path top (take rel i)))))
+  (for ([dir (in-list ancestors)])
+    (check-xvfb-info dir))
+  (for/or ([q (in-list (cons p ancestors))])
+    (hash-ref xvfb-paths q #f)))
 
 ;; Arguments for the window manager at (fluxbox-path), after any display argument
 (define wm-args '("--sm-disable" "--compositor=none"))
@@ -585,21 +591,32 @@
   (require rackunit "status.rkt")
 
   ;; tests/xvfb/info.rkt lists gui-test.rkt, print-display.rkt, focus.rkt,
-  ;; and the tests directory in test-xvfb-paths
+  ;; nested/listed.rkt, and the tests directory in test-xvfb-paths
   (define-runtime-path xvfb-dir "tests/xvfb")
 
-  ;; Clear caches from any prior test run
-  (hash-clear! xvfb-paths)
-  (hash-clear! xvfb-info-done)
+  ;; Checks a path with empty caches, as for the first test DrDr runs in a
+  ;; directory tree, so that no earlier check has read an info.rkt for it
+  (define (needs-xvfb? . elems)
+    (hash-clear! xvfb-paths)
+    (hash-clear! xvfb-info-done)
+    (and (path-needs-xvfb? (apply build-path xvfb-dir elems) xvfb-dir) #t))
 
   ;; File listed directly should match
-  (check-true (and (path-needs-xvfb? (build-path xvfb-dir "gui-test.rkt") xvfb-dir) #t))
+  (check-true (needs-xvfb? "gui-test.rkt"))
 
   ;; File under a listed directory should match
-  (check-true (and (path-needs-xvfb? (build-path xvfb-dir "tests" "visual.rkt") xvfb-dir) #t))
+  (check-true (needs-xvfb? "tests" "visual.rkt"))
 
-  ;; File not listed should not match
-  (check-false (path-needs-xvfb? (build-path xvfb-dir "other.rkt") xvfb-dir))
+  ;; File two levels under a listed directory should match
+  (check-true (needs-xvfb? "tests" "deeper" "deep.rkt"))
+
+  ;; File in a subdirectory, listed by its parent directory's info.rkt,
+  ;; should match
+  (check-true (needs-xvfb? "nested" "listed.rkt"))
+
+  ;; Files not listed should not match
+  (check-false (needs-xvfb? "other.rkt"))
+  (check-false (needs-xvfb? "nested" "unlisted.rkt"))
 
   ;; Integration tests: maybe-wrap-xvfb drives xvfb-run wrapping of the command
   ;; Find raco next to the currently running racket binary
diff --git a/tests/xvfb/info.rkt b/tests/xvfb/info.rkt
index 5fb9ba0..1ff82e6 100644
--- a/tests/xvfb/info.rkt
+++ b/tests/xvfb/info.rkt
@@ -2,5 +2,6 @@
 
 ;; A fixture for plt-build.rkt's tests of test-xvfb-paths; plt-build.rkt
 ;; runs these files itself.
-(define test-xvfb-paths '("gui-test.rkt" "tests" "print-display.rkt" "focus.rkt"))
+(define test-xvfb-paths
+  '("gui-test.rkt" "tests" "print-display.rkt" "focus.rkt" "nested/listed.rkt"))
 (define test-omit-paths 'all)
diff --git a/tests/xvfb/nested/listed.rkt b/tests/xvfb/nested/listed.rkt
new file mode 100644
index 0000000..16a753b
--- /dev/null
+++ b/tests/xvfb/nested/listed.rkt
@@ -0,0 +1,2 @@
+#lang racket/base
+;; Listed in test-xvfb-paths by the parent directory's info.rkt
diff --git a/tests/xvfb/nested/unlisted.rkt b/tests/xvfb/nested/unlisted.rkt
new file mode 100644
index 0000000..e55a9cf
--- /dev/null
+++ b/tests/xvfb/nested/unlisted.rkt
@@ -0,0 +1,2 @@
+#lang racket/base
+;; Not covered by test-xvfb-paths, though a sibling is
diff --git a/tests/xvfb/tests/deeper/deep.rkt b/tests/xvfb/tests/deeper/deep.rkt
new file mode 100644
index 0000000..fd0d8af
--- /dev/null
+++ b/tests/xvfb/tests/deeper/deep.rkt
@@ -0,0 +1,2 @@
+#lang racket/base
+;; Covered by test-xvfb-paths through a directory two levels up