Fix #lang resyntax/test coverage reports (#648)

Author: jackfirth

.github/workflows/main.yml

@@ -14,6 +14,6 @@ jobs:
       - run: raco pkg install --batch --auto cover cover-coveralls
       - run: raco pkg install --batch --auto --link --name resyntax
       - run: raco test --package resyntax
-      - run: raco cover --format coveralls --package resyntax
+      - run: raco cover --format coveralls --suppress-log-execution --package resyntax
         env:
           COVERALLS_REPO_TOKEN: ${{ secrets.COVERALLS_REPO_TOKEN }}

default-recommendations/windows-newline-test.rkt

@@ -11,6 +11,8 @@
 
 
 (module+ test
+  (clear-suites-under-test!)
+  (clear-header!)
   (test-case "windows-style newlines should be replaced with regular newlines"
     (parameterize ([current-suite-under-test default-recommendations])
       (define program

test.rkt

@@ -14,6 +14,8 @@
 (require (for-syntax racket/base
                      racket/match
                      resyntax/test/private/statement)
+         racket/runtime-path
+         racket/splicing
          rackunit
          rebellion/base/comparator
          rebellion/base/range
@@ -227,13 +229,29 @@
 (define-syntax (resyntax-test-module-begin stx)
   (syntax-parse stx
     [(_ body ...)
-     (define has-require? (has-require-statements? (attribute body)))
-     (if has-require?
-         #`(racket-module-begin (module+ test body ...))
-         #`(racket-module-begin
-            (module+ test
-              (add-suite-under-test! default-recommendations)
-              body ...)))]))
+     #:do [(define has-require? (has-require-statements? (attribute body)))
+           (define has-src-path? (and (syntax-source stx) (path? (syntax-source stx))))]
+     #:attr default-require (and (not has-require?) #'(add-suite-under-test! default-recommendations))
+     #:attr stx-path (and has-src-path? #`'#,(build-path (syntax-source stx) 'up))
+     #'(racket-module-begin
+        (module+ test
+          ;; We always clear the suites under test first in case this test file is executing in the
+          ;; same (dynamic) module namespace as another test file. If we didn't do this, because the
+          ;; suites under test are stored in a global parameter, then a test runner that reuses
+          ;; namespaces across files might accidentally run extra refactoring rules that the test file
+          ;; didn't specify. The `raco cover` tool is one such test runner: without this reset,
+          ;; coverage reporting with `raco cover` stops working.
+          (clear-suites-under-test!)
+          ;; Similarly, we also clear the test header global parameter.
+          (clear-header!)
+          (~? (~@ (define-runtime-path here stx-path)
+                  ;; We also force the current directory to the module's source location's directory.
+                  ;; Cover doesn't do this automatically like raco test does for some reason, and not
+                  ;; doing it breaks tests that use relative path imports inside refactored test code.
+                  (splicing-parameterize ([current-directory here])
+                    (~? default-require)
+                    body ...))
+              (~@ (~? default-require) body ...))))]))
 
 
 ;@----------------------------------------------------------------------------------------------------

test/info.rkt

@@ -0,0 +1,6 @@
+#lang info
+
+
+; This test file causes Cover to hang for some reason, likely related to logging.
+(define cover-omit-paths
+  (list "testing-lang-test.rkt"))

test/private/rackunit.rkt

@@ -5,7 +5,9 @@
          current-suite-under-test
          current-header
          current-line-mask
+         clear-header!
          set-header!
+         clear-suites-under-test!
          add-suite-under-test!
          check-suite-refactors
          check-suite-does-not-refactor
@@ -84,6 +86,10 @@
 (define current-suite-under-test (make-parameter (refactoring-suite #:rules '())))
 
 
+(define (clear-suites-under-test!)
+  (current-suite-under-test (refactoring-suite #:rules '())))
+
+
 (define (add-suite-under-test! suite)
   (define current-rules (refactoring-suite-rules (current-suite-under-test)))
   (define new-rules (append current-rules (refactoring-suite-rules suite)))
@@ -93,6 +99,10 @@
 (define current-header (make-parameter (code-block "")))
 
 
+(define (clear-header!)
+  (current-header (code-block "")))
+
+
 (define (set-header! header-code)
   (unless (equal? (current-header) (code-block ""))
     (raise-arguments-error 'header: "the header has already been set"))