Skip to content

Commit fa9473e

Browse files
Copilotjackfirth
andcommitted
Add comprehensive tests for file-group.rkt to improve coverage
Co-authored-by: jackfirth <[email protected]>
1 parent e55397d commit fa9473e

File tree

1 file changed

+159
-0
lines changed

1 file changed

+159
-0
lines changed

private/file-group.rkt

Lines changed: 159 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,9 @@
4545

4646
(module+ test
4747
(require (submod "..")
48+
racket/file
49+
racket/list
50+
racket/system
4851
rackunit))
4952

5053

@@ -136,6 +139,162 @@
136139

137140

138141
(module+ test
142+
143+
(test-case "file-portion"
144+
(test-case "constructor normalizes paths"
145+
(define portion (file-portion "/tmp/test.rkt" (range-set (closed-open-range 1 10 #:comparator natural<=>))))
146+
(check-true (file-portion? portion))
147+
(check-equal? (file-portion-path portion) (simple-form-path "/tmp/test.rkt"))
148+
(check-equal? (file-portion-lines portion) (range-set (closed-open-range 1 10 #:comparator natural<=>)))))
149+
150+
(test-case "single-file-group"
151+
(test-case "constructor and predicates"
152+
(define group (single-file-group "/tmp/test.rkt" (range-set (closed-open-range 1 10 #:comparator natural<=>))))
153+
(check-true (single-file-group? group))
154+
(check-true (file-group? group))
155+
(check-equal? (single-file-group-path group) (simple-form-path "/tmp/test.rkt"))
156+
(check-equal? (single-file-group-ranges group) (range-set (closed-open-range 1 10 #:comparator natural<=>))))
157+
158+
(test-case "file-group-resolve returns single file"
159+
(define test-dir (make-temporary-file "resyntax-test-~a" 'directory))
160+
(define test-file (build-path test-dir "test.rkt"))
161+
(call-with-output-file test-file
162+
(λ (out) (displayln "#lang racket/base" out)))
163+
(define group (single-file-group test-file (range-set (closed-open-range 1 5 #:comparator natural<=>))))
164+
(define portions (file-group-resolve group))
165+
(check-equal? (length portions) 1)
166+
(check-equal? (file-portion-path (first portions)) (simple-form-path test-file))
167+
(check-equal? (file-portion-lines (first portions)) (range-set (closed-open-range 1 5 #:comparator natural<=>)))
168+
(delete-directory/files test-dir)))
169+
170+
(test-case "directory-file-group"
171+
(test-case "constructor and predicates"
172+
(define group (directory-file-group "/tmp"))
173+
(check-true (directory-file-group? group))
174+
(check-true (file-group? group))
175+
(check-equal? (directory-file-group-path group) (simple-form-path "/tmp")))
176+
177+
(test-case "file-group-resolve returns only .rkt files"
178+
(define test-dir (make-temporary-file "resyntax-test-~a" 'directory))
179+
(define rkt-file1 (build-path test-dir "test1.rkt"))
180+
(define rkt-file2 (build-path test-dir "test2.rkt"))
181+
(define txt-file (build-path test-dir "test.txt"))
182+
(call-with-output-file rkt-file1
183+
(λ (out) (displayln "#lang racket/base" out)))
184+
(call-with-output-file rkt-file2
185+
(λ (out) (displayln "#lang racket" out)))
186+
(call-with-output-file txt-file
187+
(λ (out) (displayln "not racket" out)))
188+
(define group (directory-file-group test-dir))
189+
(define portions (file-group-resolve group))
190+
(check-equal? (length portions) 2)
191+
(check-true (andmap (λ (p) (path-has-extension? (file-portion-path p) #".rkt")) portions))
192+
(delete-directory/files test-dir)))
193+
194+
(test-case "package-file-group"
195+
(test-case "constructor and predicates"
196+
(define group (package-file-group "rackunit"))
197+
(check-true (package-file-group? group))
198+
(check-true (file-group? group))
199+
(check-equal? (package-file-group-package-name group) "rackunit"))
200+
201+
(test-case "file-group-resolve returns files from installed package"
202+
(define group (package-file-group "rackunit"))
203+
(define portions (file-group-resolve group))
204+
(check-true (list? portions))
205+
(check-true (andmap file-portion? portions))
206+
(check-true (andmap (λ (p) (path-has-extension? (file-portion-path p) #".rkt")) portions))
207+
(check-true (> (length portions) 0)))
208+
209+
(test-case "file-group-resolve raises error for non-existent package"
210+
(define group (package-file-group "this-package-does-not-exist-xyz"))
211+
(check-exn exn:fail:user?
212+
(λ () (file-group-resolve group)))))
213+
214+
(test-case "git-repository-file-group"
215+
(test-case "constructor and predicates"
216+
(define group (git-repository-file-group "/tmp" "HEAD"))
217+
(check-true (git-repository-file-group? group))
218+
(check-true (file-group? group))
219+
(check-equal? (git-repository-file-group-repository-path group) (simple-form-path "/tmp"))
220+
(check-equal? (git-repository-file-group-ref group) "HEAD"))
221+
222+
(test-case "file-group-resolve with git repository"
223+
(define test-dir (make-temporary-file "resyntax-test-git-~a" 'directory))
224+
(parameterize ([current-directory test-dir])
225+
(system "git init -q")
226+
(system "git config user.email '[email protected]'")
227+
(system "git config user.name 'Test User'")
228+
(define test-file (build-path test-dir "test.rkt"))
229+
(call-with-output-file test-file
230+
(λ (out) (displayln "#lang racket/base\n(void)" out)))
231+
(system "git add test.rkt")
232+
(system "git commit -q -m 'Initial commit'")
233+
(call-with-output-file test-file #:exists 'append
234+
(λ (out) (displayln "(define x 1)" out)))
235+
(define group (git-repository-file-group test-dir "HEAD"))
236+
(define portions (file-group-resolve group))
237+
(check-true (list? portions))
238+
(check-true (> (length portions) 0))
239+
(check-true (andmap file-portion? portions)))
240+
(delete-directory/files test-dir)))
241+
242+
(test-case "file-groups-resolve"
243+
(test-case "resolves multiple groups into hash"
244+
(define test-dir (make-temporary-file "resyntax-test-~a" 'directory))
245+
(define test-file1 (build-path test-dir "test1.rkt"))
246+
(define test-file2 (build-path test-dir "test2.rkt"))
247+
(call-with-output-file test-file1
248+
(λ (out) (displayln "#lang racket/base" out)))
249+
(call-with-output-file test-file2
250+
(λ (out) (displayln "#lang racket" out)))
251+
(define group1 (single-file-group test-file1 (range-set (closed-open-range 1 5 #:comparator natural<=>))))
252+
(define group2 (single-file-group test-file2 (range-set (closed-open-range 3 8 #:comparator natural<=>))))
253+
(define result (file-groups-resolve (list group1 group2)))
254+
(check-true (hash? result))
255+
(check-equal? (hash-count result) 2)
256+
(check-true (hash-has-key? result (file-source test-file1)))
257+
(check-true (hash-has-key? result (file-source test-file2)))
258+
(delete-directory/files test-dir))
259+
260+
(test-case "combines ranges for same file"
261+
(define test-dir (make-temporary-file "resyntax-test-~a" 'directory))
262+
(define test-file (build-path test-dir "test.rkt"))
263+
(call-with-output-file test-file
264+
(λ (out) (displayln "#lang racket/base" out)))
265+
(define group1 (single-file-group test-file (range-set (closed-open-range 1 3 #:comparator natural<=>))))
266+
(define group2 (single-file-group test-file (range-set (closed-open-range 5 7 #:comparator natural<=>))))
267+
(define result (file-groups-resolve (list group1 group2)))
268+
(check-equal? (hash-count result) 1)
269+
(define combined-ranges (hash-ref result (file-source test-file)))
270+
(check-true (range-set-contains? combined-ranges 1))
271+
(check-true (range-set-contains? combined-ranges 2))
272+
(check-true (range-set-contains? combined-ranges 5))
273+
(check-true (range-set-contains? combined-ranges 6))
274+
(delete-directory/files test-dir)))
275+
276+
(test-case "rkt-file?"
277+
(test-case "returns true for .rkt files"
278+
(define portion (file-portion "/tmp/test.rkt" (range-set #:comparator natural<=>)))
279+
(check-true (rkt-file? portion)))
280+
281+
(test-case "returns false for non-.rkt files"
282+
(define portion1 (file-portion "/tmp/test.txt" (range-set #:comparator natural<=>)))
283+
(define portion2 (file-portion "/tmp/test.scm" (range-set #:comparator natural<=>)))
284+
(check-false (rkt-file? portion1))
285+
(check-false (rkt-file? portion2))))
286+
287+
(test-case "range-bound-map"
288+
(test-case "maps bounded endpoints"
289+
(define bound (range-bound 5 inclusive))
290+
(define result (range-bound-map bound (λ (x) (* x 2))))
291+
(check-equal? (range-bound-endpoint result) 10)
292+
(check-equal? (range-bound-type result) inclusive))
293+
294+
(test-case "preserves unbounded"
295+
(define result (range-bound-map unbounded (λ (x) (* x 2))))
296+
(check-equal? result unbounded)))
297+
139298
(test-case "expand-modified-line-set"
140299
(define ranges (range-set (closed-open-range 4 6) (greater-than-range 15)))
141300
(define expected (range-set (closed-open-range 1 9) (greater-than-range 12)))

0 commit comments

Comments
 (0)