test-rendering.rkt

#lang racket/base
;; Tests for the DrDr web interface.
;; Uses synthetic data and web-server/test to exercise page rendering.
(require rackunit
         racket/file
         racket/list
         racket/match
         racket/path
         racket/promise
         net/url
         xml/path
         web-server/test
         web-server/http
         web-server/servlet-dispatch
         (only-in web-server/dispatchers/dispatch exn:dispatcher?)
         "dirstruct.rkt"
         "rendering.rkt"
         "status.rkt"
         "scm.rkt"
         "path-utils.rkt"
         "cache.rkt"
         "analyze.rkt"
         "make-archive-lib.rkt"
         "render.rkt")

;; --- Synthetic data setup ---

(define test-file-path "cs/pkgs/racket-test/tests/example.rkt")

(define (make-test-revision rev
                            #:status [status-type 'success]
                            #:duration-ms [dur-ms 5000]
                            #:changed? [changed? #f]
                            #:author [author "tester"])
  (define log-dir (revision-log-dir rev))
  (define log-pth (build-path log-dir test-file-path))

  (make-directory* (path-only log-pth))

  ;; Write commit-msg
  (define short-hash (substring (string-append (make-string 40 #\a)) 0 40))
  (define commit
    (make-git-diff* "refs/heads/master"
                    short-hash
                    author
                    "2026-02-15 10:00:00 +0000"
                    (list (format "Test commit for rev ~a" rev))
                    (list "collects/tests/test.rkt")))
  (write-to-file* (make-git-push rev author (list commit)) (revision-commit-msg rev))

  ;; Write analyzed marker
  (write-to-file* (current-seconds) (build-path (revision-dir rev) "analyzed"))

  ;; Write log (status struct)
  (define start-ms (* 1000000000.0))
  (define end-ms (+ start-ms dur-ms))
  (define the-log
    (case status-type
      [(timeout)
       (make-timeout start-ms
                     end-ms
                     (list "raco" "test" test-file-path)
                     (list (make-stdout #"running tests...\n") (make-stderr #"timeout exceeded\n")))]
      [(failure)
       (make-exit start-ms
                  end-ms
                  (list "raco" "test" test-file-path)
                  (list (make-stdout #"running tests...\n") (make-stderr #"FAILURE: test failed\n"))
                  1)]
      [(stderr)
       (make-exit start-ms
                  end-ms
                  (list "raco" "test" test-file-path)
                  (list (make-stdout #"running tests...\n") (make-stderr #"warning: something\n"))
                  0)]
      [else
       (make-exit start-ms
                  end-ms
                  (list "raco" "test" test-file-path)
                  (list (make-stdout #"running tests...\nall tests passed\n"))
                  0)]))
  (write-to-file* the-log log-pth)

  ;; Run analysis to create all analyze cache files
  (parameterize ([current-rev rev])
    (analyze-logs rev)))

(define (call-with-test-data thunk)
  (define test-dir (make-temporary-file "drdr-test-~a" 'directory))
  (dynamic-wind
   (lambda ()
     (plt-directory test-dir)
     (make-directory* (plt-build-directory))
     (make-directory* (plt-future-build-directory))
     (make-directory* (plt-data-directory))
     ;; Use 'cache mode during setup so analyze-logs can write cache files
     (cache/file-mode 'cache)
     (make-test-revision 70100 #:status 'success #:duration-ms 3200 #:author "alice")
     (make-test-revision 70101 #:status 'success #:duration-ms 3400 #:changed? #t #:author "bob")
     (make-test-revision 70102 #:status 'failure #:duration-ms 4100 #:changed? #t #:author "alice")
     (make-test-revision 70103 #:status 'timeout #:duration-ms 90000 #:changed? #t #:author "bob")
     ;; Switch to 'no-cache for tests, matching the web server's mode
     (cache/file-mode 'no-cache))
   thunk
   (lambda () (delete-directory/files test-dir #:must-exist? #f))))

;; --- Test helpers ---

(define (test-request/url url-str)
  (make-request #"GET"
                (string->url url-str)
                empty
                (delay
                  empty)
                #f
                "127.0.0.1"
                80
                "127.0.0.1"))

(define (dispatch-request url-str)
  (parameterize ([drdr-start-request (current-inexact-milliseconds)])
    (top-dispatch (test-request/url url-str))))

(define (response-body resp)
  (define out (open-output-bytes))
  ((response-output resp) out)
  (bytes->string/utf-8 (get-output-bytes out)))

;; --- Tests ---

(define render-tests
  (test-suite "DrDr web rendering"

    (test-case "front page lists revisions"
      (call-with-test-data (lambda ()
                             (define resp (dispatch-request "http://localhost/"))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             (check-regexp-match #rx"70103" body)
                             (check-regexp-match #rx"70102" body)
                             (check-regexp-match #rx"70101" body)
                             (check-regexp-match #rx"70100" body)
                             (check-regexp-match #rx"alice" body)
                             (check-regexp-match #rx"bob" body))))

    (test-case "revision page shows directory listing"
      (call-with-test-data (lambda ()
                             (define resp (dispatch-request "http://localhost/70101/"))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             (check-regexp-match #rx"bob" body)
                             (check-regexp-match #rx"Test commit for rev 70101" body))))

    (test-case "file result page shows test output"
      (call-with-test-data (lambda ()
                             (define resp
                               (dispatch-request (format "http://localhost/70101/~a" test-file-path)))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             (check-regexp-match #rx"all tests passed" body)
                             (check-regexp-match #rx"3\\.40s" body)
                             (check-regexp-match #rx"Exit Code.*0" body))))

    (test-case "failure file result shows stderr"
      (call-with-test-data (lambda ()
                             (define resp
                               (dispatch-request (format "http://localhost/70102/~a" test-file-path)))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             (check-regexp-match #rx"FAILURE" body)
                             (check-regexp-match #rx"Exit Code.*1" body))))

    (test-case "timeout file result shows timeout"
      (call-with-test-data (lambda ()
                             (define resp
                               (dispatch-request (format "http://localhost/70103/~a" test-file-path)))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             (check-regexp-match #rx"timeout exceeded" body)
                             (check-regexp-match #rx"10004" body)))) ; checkmark entity for timeout

    (test-case "help page renders"
      (call-with-test-data (lambda ()
                             (define resp (dispatch-request "http://localhost/help"))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             (check-regexp-match #rx"What is DrDr" body))))

    (test-case "a revision that names no build matches no rule"
      (call-with-test-data
       (lambda ()
         (for ([url (in-list '("http://localhost/1489401258/"
                               "http://localhost/1489401258/pkgs/x.rkt"
                               "http://localhost/previous-change/1489401258/pkgs/x.rkt"))])
           (check-exn exn:dispatcher? (lambda () (dispatch-request url)))))))

    (test-case "nonexistent file returns not found message"
      (call-with-test-data (lambda ()
                             (define resp (dispatch-request "http://localhost/70101/no/such/file.rkt"))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             (check-regexp-match #rx"does not exist" body))))

    (test-case "file history page lists all revisions"
      (call-with-test-data (lambda ()
                             (define resp
                               (dispatch-request
                                (format "http://localhost/file-history/~a" test-file-path)))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             (check-regexp-match #rx"File History" body)
                             (check-regexp-match #rx"70100" body)
                             (check-regexp-match #rx"70101" body)
                             (check-regexp-match #rx"70102" body)
                             (check-regexp-match #rx"70103" body))))

    (test-case "file history page shows status for each revision"
      (call-with-test-data (lambda ()
                             (define resp
                               (dispatch-request
                                (format "http://localhost/file-history/~a" test-file-path)))
                             (define body (response-body resp))
                             (check-regexp-match #rx"Success" body)
                             (check-regexp-match #rx"Failure \\+ Stderr" body)
                             (check-regexp-match #rx"Timeout" body))))

    (test-case "file history page shows stderr status for exit-0 with stderr"
      (call-with-test-data (lambda ()
                             (parameterize ([cache/file-mode 'cache])
                               (make-test-revision 70104 #:status 'stderr #:author "carol"))
                             (define resp
                               (dispatch-request
                                (format "http://localhost/file-history/~a" test-file-path)))
                             (define body (response-body resp))
                             (check-regexp-match #rx"Stderr" body))))

    (test-case "file history page shows exit codes"
      (call-with-test-data (lambda ()
                             (define resp
                               (dispatch-request
                                (format "http://localhost/file-history/~a" test-file-path)))
                             (define body (response-body resp))
                             (check-regexp-match #rx"Exit Code" body)
                             ;; Success revisions show exit code 0
                             (check-regexp-match #rx"<td>0</td>" body)
                             ;; Failure revision shows exit code 1
                             (check-regexp-match #rx"<td>1</td>" body))))

    (test-case "file history page shows missing for revisions without file"
      (call-with-test-data (lambda ()
                             ;; Create a revision with no log for test-file-path
                             (make-directory* (revision-log-dir 99))
                             (make-directory* (revision-analyze-dir 99))
                             (write-to-file* (current-seconds)
                                             (build-path (revision-dir 99) "analyzed"))
                             (define resp
                               (dispatch-request
                                (format "http://localhost/file-history/~a" test-file-path)))
                             (define body (response-body resp))
                             (check-regexp-match #rx"99" body)
                             (check-regexp-match #rx"Missing" body))))

    (test-case "file history page shows pending for incomplete revisions"
      (call-with-test-data (lambda ()
                             ;; Create a revision directory with no "analyzed" marker
                             (make-directory* (revision-log-dir 70104))
                             (make-directory* (revision-analyze-dir 70104))
                             (define resp
                               (dispatch-request
                                (format "http://localhost/file-history/~a" test-file-path)))
                             (define body (response-body resp))
                             (check-regexp-match #rx"70104" body)
                             (check-regexp-match #rx"Pending" body)
                             ;; Should NOT show "Missing" for rev 70104
                             ;; (Missing should only appear for completed rev 99 if present)
                             )))

    (test-case "file result page links to file history"
      (call-with-test-data (lambda ()
                             (define resp
                               (dispatch-request (format "http://localhost/70101/~a" test-file-path)))
                             (define body (response-body resp))
                             (check-regexp-match #rx"file-history" body)
                             (check-regexp-match #rx"All results for this file" body))))

    (test-case "file history page reads archived revisions correctly"
      ;; Regression test: archived revisions used to show as "Pending" because
      ;; show-file-history called file-exists? on the analyze and "analyzed"
      ;; marker files, which fails after archiving deletes them. The fix is to
      ;; use read-cache* which falls through to the archive.
      (call-with-test-data (lambda ()
                             ;; Archive revs 70101, 70102, 70103 (70101 is success,
                             ;; 70102 is failure, 70103 is timeout). Rev 70100 is
                             ;; skipped because make-archive doesn't archive
                             ;; multiples of 100.
                             (make-archive 70101)
                             (make-archive 70102)
                             (make-archive 70103)
                             (define resp
                               (dispatch-request
                                (format "http://localhost/file-history/~a" test-file-path)))
                             (check-equal? (response-code resp) 200)
                             (define body (response-body resp))
                             ;; Archived revisions must show their real status,
                             ;; not "Pending".
                             (check-regexp-match #rx"Success" body)
                             (check-regexp-match #rx"Failure \\+ Stderr" body)
                             (check-regexp-match #rx"Timeout" body)
                             (check-false (regexp-match? #rx"Pending" body)))))))

(module+ test
  (require rackunit/text-ui)
  (run-tests render-tests))