Overview
Context
Changes
Modified path-glob/path-glob.scm
from [3de22bebd8]
to [80dc7776c7].
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
|
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 '("." ".." "/")) 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 '())
(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
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
|
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/*" "." ".." "*"))
(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 "\n\nGlobber: " 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 "Compare the globbers")
(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)
|