-
Notifications
You must be signed in to change notification settings - Fork 9
/
test-driver.rkt
133 lines (117 loc) · 4.85 KB
/
test-driver.rkt
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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#lang racket
(require racket/generator
rackunit
"rust-file-list.rkt")
(define dev-null (open-output-file "/dev/null"
#:exists 'update))
;; if processing drops below this pace, indicate
;; failure and continue with the next batch
(define MIN-LINES-PER-SECOND 5)
;; GRR: the testrig doesn't clearly signal parse failures....
;; is this line indicative of an error?
(define (is-errline? line)
(match line
[(regexp #px#"^/") #f]
[(regexp #px#"^line ") #t]
[(regexp #px#"") #f]
[other (error "can't categorize this line: ~e" line)]))
;; return only the error lines from stderr
(define (only-errlines errtxt)
(filter is-errline? (regexp-split #px"\n" errtxt)))
;; run the parser on all files in the given directory, skipping the
;; ones matching the "skip-list" list of patterns, parsing using
;; the nonterminal specified by 'nonterm', running the given number in
;; parallel, and optionally skipping all files until finding one
;; that matches the 'start-with-pat' pattern
(define (run-tests given-filenames nonterm num-to-run-in-parallel
[start-with-pat #f])
(define filenames (take given-filenames 640))
(when (empty? filenames)
(error 'run-tests
"empty list of files to test"))
(define filenames2 (cond [start-with-pat
(dropf filenames (lambda (f)
(not (regexp-match start-with-pat f))))]
[else filenames]))
(when (empty? filenames2)
(error 'run-tests
"ran out of files while searching for pattern: ~e" start-with-pat))
(let loop ([remaining filenames2] [failed empty])
(cond [(empty? remaining)
(when (not (empty? failed))
(error 'run-tests
"some files timed out: ~s" failed))]
[else
(define-values (next-bunch new-remaining)
(split-at remaining (min num-to-run-in-parallel (length remaining))))
(cond [(run-bunch nonterm next-bunch)
(loop new-remaining failed)]
[else
(loop new-remaining (append next-bunch failed))])])))
;; test a bunch of files at once:
(define (run-bunch nonterm bunch)
(define total-lines (apply + (map file-lines bunch)))
(define pre-time (current-inexact-milliseconds))
(display (~a "Testing files containing "total-lines" lines of source code.\n"))
(match-define (list _1 stdin _2 stderr control)
(process/ports
dev-null
#f
#f
(let ([ans (~a "java -Xmx2g org.antlr.v4.runtime.misc.TestRig Rust "
nonterm" -encoding UTF-8 "
(apply string-append (add-between bunch " ")))])
(printf "~s\n" ans)
ans)))
(close-output-port stdin)
(define seconds-to-wait (/ total-lines MIN-LINES-PER-SECOND))
(define wait-thread (thread (lambda () (control 'wait))))
(define wait-result
(sync/timeout seconds-to-wait wait-thread))
;; kill the process if it times out:
(cond
[(not wait-result)
;; On Windows, this probably won't kill the process:
(control 'kill)
(display
(~a "*** TIMEOUT: processing of files aborted after waiting "(~r seconds-to-wait)" seconds (= "MIN-LINES-PER-SECOND" lines per second):\n"bunch"\n")
(current-error-port))
#f]
[else
(define result (control 'status))
(define errtext (first (regexp-match #px".*" stderr)))
(close-input-port stderr)
(define errlines (only-errlines errtext))
(when (or (not (eq? 'done-ok result))
(not (empty? errlines)))
(error
(format "test of files ~s failed with result ~s and stderr\n~a"
bunch result errtext)))
(define post-time (current-inexact-milliseconds))
(define elapsed (/ (- post-time pre-time) 1000.0))
(define lines-per-second (/ total-lines elapsed))
(printf "parsing ran at ~a lines per second\n" (~r #:precision 2 lines-per-second))
#t]))
;; this'll be slow, but probably not nearly as long as the parsing...
(define (file-lines path)
(length (file->lines path)))
;; return true if a ends with the string sought
(define (string-ends-with a sought)
(and (<= (string-length sought) (string-length a))
(string=? (substring a (- (string-length a) (string-length sought)) (string-length a))
sought)))
(check-equal? (string-ends-with "abc" "bc") #t)
(check-equal? (string-ends-with "abc" "abc") #t)
(check-equal? (string-ends-with "abc" "zabc") #f)
#;(run-tests (make-lexer-list "/Users/clements/tryrust/src/")
"tts"
32
#;#px"zip-same-length.rs$")
(run-tests (make-parser-list "/Users/clements/tryrust/src/")
"prog"
2
#;#px"zip-same-length.rs$")
;3:50:33 total 1-at-a-time
;1:27.62 8-at-a-time
;1:15.73 total 16-at-a-time
;1:13.03 total 32-at-a-time