Overview
| Comment: | Improved the path glob tests |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
c5229569095ff3749bf58ea164ae082e |
| User & Date: | mrwellan on 2019-11-22 12:54:55 |
| Other Links: | branch diff | manifest | tags |
Context
|
2019-11-25
| ||
| 10:56 | Eliminate the testing of multi-glob check-in: bce20f2af9 user: mrwellan tags: v1.65 | |
|
2019-11-22
| ||
| 12:54 | Improved the path glob tests check-in: c522956909 user: mrwellan tags: v1.65 | |
| 09:17 | Added test for the path-glob check-in: a7f72a923a user: mrwellan tags: v1.65 | |
Changes
Modified path-glob/path-glob.scm from [3de22bebd8] to [80dc7776c7].
1 2 3 4 5 6 7 |
(define (multi-glob pathspec)
(let* ((path-parts (intersperse (string-split pathspec "/" #t) "/")))
(if (null? path-parts)
'()
(let loop ((parts (cdr path-parts))
(result (let ((p (car path-parts)))
(if (string=? p "")
| > | > | > | | | | > > | | > | 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 |
(define (multi-glob pathspec)
(let* ((path-parts (intersperse (string-split pathspec "/" #t) "/")))
(print "path-parts: " path-parts)
(if (null? path-parts)
'()
(let loop ((parts (cdr path-parts))
(result (let ((p (car path-parts)))
(if (string=? p "")
'("")
(glob (car path-parts))))))
(if (null? parts)
result
(let* ((part (car parts))
(rem (cdr parts)))
(loop rem
(apply append
(map (lambda (curr)
(let ((new (string-append curr part)))
(print "new: " new " part: " part)
(cond
((and (directory? curr)(file-read-access? curr))
(glob new))
((member part '("." ".." "/")) (list new part))
(else '()))))
result)))))))))
;; alternative implementation
(define (path-glob pattern)
(let ((parts (string-split pattern "/" '())))
(if (null? parts)
'()
(glob-expand (car parts) (cdr parts))
)))
(define (glob-expand pattern #!optional (rest '()))
(let ((result '())
(expanded (glob pattern)))
(apply append result (cond
((null? expanded) (list '()))
((null? rest) (list expanded))
(else (map (lambda (x)
(if (directory? x)
(glob-expand (conc x "/" (car rest)) (cdr rest))
'()))
expanded))))))
|
Modified path-glob/test.scm from [f3fe558fbc] to [6e4b85d0ba].
1 2 3 4 5 |
(use test posix srfi-1)
(load "path-glob.scm")
(define globbers `((multi-glob . ,multi-glob)(path-glob . ,path-glob)))
(define interesting-patts '("../*/*" "/*/bin/*" "./*/bin/*"))
| | | | | 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 |
(use test posix srfi-1)
(load "path-glob.scm")
(define globbers `((multi-glob . ,multi-glob)(path-glob . ,path-glob)))
(define interesting-patts '("../*/*" "/*/bin/*" "./*/bin/*"))
(define simple-patts '("../*" "/*" "/bin/*" "." ".." "*" "a[0-1]*"))
(define (trim-list lst)
(if (> (length lst) 3)
(append (take lst 3) '(...))
lst))
(define (generate-prefix patt)
(write (conc "patt: " patt (make-string (- 10 (string-length patt)) #\ ))))
(print "\nCompare each globber with glob") ;; can only do one level globs here
(for-each
(lambda (globber)
(print "\nGlobber: " globber " vs glob")
(for-each
(lambda (patt)
(generate-prefix patt)
(test #f '() (trim-list
(lset-xor string=? ((alist-ref globber globbers) patt)(glob patt)))))
simple-patts))
(map car globbers))
(print "\nTest the globbers against patts - only checks for resiliance, not correctness.")
(for-each
(lambda (patt)
(generate-prefix patt)(test #f #t (list? (path-glob patt)))
(generate-prefix patt)(test #f #t (list? (multi-glob patt)))
)
interesting-patts)
(print "\nCompare the globbers against each other")
(for-each
(lambda (patt)
(generate-prefix patt)
(test #f '() (trim-list
(lset-xor string=? (path-glob patt)(multi-glob patt)))))
interesting-patts)
(test-exit)
|