drdr/metadata.rkt at master · racket/drdr · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
#lang racket/base
(require racket/path
         racket/match
         racket/list
         racket/contract/base
         racket/string
         racket/set
         "status.rkt"
         "path-utils.rkt"
         "dirstruct.rkt"
         "scm.rkt")
(module+ test
  (require rackunit))

(define (path-command-line a-path a-timeout)
  `(raco "test" "-m" "--timeout" ,(number->string a-timeout)
    ,(path->string* a-path)))

(define (listify x)
  (if (list? x) x (list x)))

(define (calculate-responsible output-log)
  (set->responsible
   (for/fold ([r (responsible->set "")])
             ([e (in-list output-log)])
     (match e
       [(stdout (regexp #rx#"^raco test: @\\(test-responsible '(.+)\\)$"
                        (list _ who)))
        (set-union
         r
         (list->set
          (map (λ (x) (format "~a" x ))
               (listify (read (open-input-bytes who))))))]
       [_
        r]))))
(module+ test
  (check-equal?
   (calculate-responsible
    (list (stdout #"blah blah blah")
          (stdout #"blah blah blah")
          (stdout #"raco test: @(test-responsible '(robby))")
          (stdout #"blah blah blah")))
   "robby")
  (check-equal?
   (calculate-responsible
    (list (stdout #"blah blah blah")
          (stdout #"blah blah blah")
          (stdout #"raco test: @(test-responsible 'robby)")
          (stdout #"blah blah blah")))
   "robby")
  (check-equal?
   (list->set
    (string-split
     (calculate-responsible
      (list (stdout #"blah blah blah")
            (stdout #"blah blah blah")
            (stdout #"raco test: @(test-responsible '(robby jay))")
            (stdout #"blah blah blah")))
     ","))
   (set "robby" "jay")))

(define (calculate-random? output-log)
  (ormap
   (λ (l)
     (and (stdout? l)
          (or (regexp-match (regexp-quote "raco test: @(test-random #t)")
                            (stdout-bytes l))
              (regexp-match (regexp-quote "DrDr: This file has random output.")
                            (stdout-bytes l)))
          #t))
   output-log))
(module+ test
  (check-equal?
   (calculate-random?
    (list (stdout #"blah blah blah")
          (stdout #"raco test: @(test-random #t)")
          (stdout #"raco test: @(test-responsible '(robby))")
          (stdout #"blah blah blah")))
   #t))

(define (calculate-known-error? output-log)
  (ormap
   (λ (l)
     (and (stdout? l)
          (regexp-match (regexp-quote "raco test: @(test-known-error #t)")
                        (stdout-bytes l))
          #t))
   output-log))

(define (responsible-append x y)
  (set->responsible
   (set-union (responsible->set x)
              (responsible->set y))))
(define (set->responsible l)
  (string-append* (add-between (set->list l) ",")))
(define (responsible->set s)
  (list->set (string-split s ",")))

(provide/contract
 [responsible-append
  (-> string? string? string?)]
 [calculate-responsible
  (-> (listof event?) string?)]
 [calculate-random?
  (-> (listof event?) boolean?)]
 [calculate-known-error?
  (-> (listof event?) boolean?)]
 [path-command-line
  (-> path-string? exact-nonnegative-integer?
      (cons/c symbol? (listof string?)))])