Artifact
f3fe558fbca386ee42b710b4eef4bdbc93e2d178:
0000: 28 75 73 65 20 74 65 73 74 20 70 6f 73 69 78 20 (use test posix
0010: 73 72 66 69 2d 31 29 0a 28 6c 6f 61 64 20 22 70 srfi-1).(load "p
0020: 61 74 68 2d 67 6c 6f 62 2e 73 63 6d 22 29 0a 0a ath-glob.scm")..
0030: 28 64 65 66 69 6e 65 20 67 6c 6f 62 62 65 72 73 (define globbers
0040: 20 60 28 28 6d 75 6c 74 69 2d 67 6c 6f 62 20 2e `((multi-glob .
0050: 20 2c 6d 75 6c 74 69 2d 67 6c 6f 62 29 28 70 61 ,multi-glob)(pa
0060: 74 68 2d 67 6c 6f 62 20 2e 20 2c 70 61 74 68 2d th-glob . ,path-
0070: 67 6c 6f 62 29 29 29 0a 28 64 65 66 69 6e 65 20 glob))).(define
0080: 69 6e 74 65 72 65 73 74 69 6e 67 2d 70 61 74 74 interesting-patt
0090: 73 20 27 28 22 2e 2e 2f 2a 2f 2a 22 20 22 2f 2a s '("../*/*" "/*
00a0: 2f 62 69 6e 2f 2a 22 20 22 2e 2f 2a 2f 62 69 6e /bin/*" "./*/bin
00b0: 2f 2a 22 29 29 0a 28 64 65 66 69 6e 65 20 73 69 /*")).(define si
00c0: 6d 70 6c 65 2d 70 61 74 74 73 20 27 28 22 2e 2e mple-patts '("..
00d0: 2f 2a 22 20 22 2f 2a 22 20 22 2f 62 69 6e 2f 2a /*" "/*" "/bin/*
00e0: 22 20 22 2e 22 20 22 2e 2e 22 20 22 2a 22 29 29 " "." ".." "*"))
00f0: 0a 0a 28 64 65 66 69 6e 65 20 28 74 72 69 6d 2d ..(define (trim-
0100: 6c 69 73 74 20 6c 73 74 29 0a 20 20 28 69 66 20 list lst). (if
0110: 28 3e 20 28 6c 65 6e 67 74 68 20 6c 73 74 29 20 (> (length lst)
0120: 33 29 0a 20 20 20 20 20 20 28 61 70 70 65 6e 64 3). (append
0130: 20 28 74 61 6b 65 20 6c 73 74 20 33 29 20 27 28 (take lst 3) '(
0140: 2e 2e 2e 29 29 0a 20 20 20 20 20 20 6c 73 74 29 ...)). lst)
0150: 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 6e 65 )..(define (gene
0160: 72 61 74 65 2d 70 72 65 66 69 78 20 70 61 74 74 rate-prefix patt
0170: 29 0a 20 20 28 77 72 69 74 65 20 28 63 6f 6e 63 ). (write (conc
0180: 20 22 70 61 74 74 3a 20 22 20 70 61 74 74 20 28 "patt: " patt (
0190: 6d 61 6b 65 2d 73 74 72 69 6e 67 20 28 2d 20 31 make-string (- 1
01a0: 30 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 0 (string-length
01b0: 20 70 61 74 74 29 29 20 23 5c 20 29 29 29 29 0a patt)) #\ )))).
01c0: 0a 28 70 72 69 6e 74 20 22 5c 6e 43 6f 6d 70 61 .(print "\nCompa
01d0: 72 65 20 65 61 63 68 20 67 6c 6f 62 62 65 72 20 re each globber
01e0: 77 69 74 68 20 67 6c 6f 62 22 29 20 3b 3b 20 63 with glob") ;; c
01f0: 61 6e 20 6f 6e 6c 79 20 64 6f 20 6f 6e 65 20 6c an only do one l
0200: 65 76 65 6c 20 67 6c 6f 62 73 20 68 65 72 65 0a evel globs here.
0210: 28 66 6f 72 2d 65 61 63 68 0a 20 28 6c 61 6d 62 (for-each. (lamb
0220: 64 61 20 28 67 6c 6f 62 62 65 72 29 0a 20 20 20 da (globber).
0230: 28 70 72 69 6e 74 20 22 5c 6e 5c 6e 47 6c 6f 62 (print "\n\nGlob
0240: 62 65 72 3a 20 22 20 67 6c 6f 62 62 65 72 29 0a ber: " globber).
0250: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
0260: 20 28 6c 61 6d 62 64 61 20 28 70 61 74 74 29 0a (lambda (patt).
0270: 20 20 20 20 20 20 28 67 65 6e 65 72 61 74 65 2d (generate-
0280: 70 72 65 66 69 78 20 70 61 74 74 29 0a 20 20 20 prefix patt).
0290: 20 20 20 28 74 65 73 74 20 23 66 20 27 28 29 20 (test #f '()
02a0: 28 74 72 69 6d 2d 6c 69 73 74 0a 09 09 20 20 20 (trim-list...
02b0: 20 28 6c 73 65 74 2d 78 6f 72 20 73 74 72 69 6e (lset-xor strin
02c0: 67 3d 3f 20 28 28 61 6c 69 73 74 2d 72 65 66 20 g=? ((alist-ref
02d0: 67 6c 6f 62 62 65 72 20 67 6c 6f 62 62 65 72 73 globber globbers
02e0: 29 20 70 61 74 74 29 28 67 6c 6f 62 20 70 61 74 ) patt)(glob pat
02f0: 74 29 29 29 29 29 0a 20 20 20 20 73 69 6d 70 6c t))))). simpl
0300: 65 2d 70 61 74 74 73 29 29 0a 20 28 6d 61 70 20 e-patts)). (map
0310: 63 61 72 20 67 6c 6f 62 62 65 72 73 29 29 0a 0a car globbers))..
0320: 28 70 72 69 6e 74 20 22 5c 6e 54 65 73 74 20 74 (print "\nTest t
0330: 68 65 20 67 6c 6f 62 62 65 72 73 20 61 67 61 69 he globbers agai
0340: 6e 73 74 20 70 61 74 74 73 20 2d 20 6f 6e 6c 79 nst patts - only
0350: 20 63 68 65 63 6b 73 20 66 6f 72 20 72 65 73 69 checks for resi
0360: 6c 69 61 6e 63 65 2c 20 6e 6f 74 20 63 6f 72 72 liance, not corr
0370: 65 63 74 6e 65 73 73 2e 22 29 0a 28 66 6f 72 2d ectness.").(for-
0380: 65 61 63 68 0a 20 28 6c 61 6d 62 64 61 20 28 70 each. (lambda (p
0390: 61 74 74 29 0a 20 20 20 28 67 65 6e 65 72 61 74 att). (generat
03a0: 65 2d 70 72 65 66 69 78 20 70 61 74 74 29 28 74 e-prefix patt)(t
03b0: 65 73 74 20 23 66 20 23 74 20 28 6c 69 73 74 3f est #f #t (list?
03c0: 20 28 70 61 74 68 2d 67 6c 6f 62 20 70 61 74 74 (path-glob patt
03d0: 29 29 29 0a 20 20 20 28 67 65 6e 65 72 61 74 65 ))). (generate
03e0: 2d 70 72 65 66 69 78 20 70 61 74 74 29 28 74 65 -prefix patt)(te
03f0: 73 74 20 23 66 20 23 74 20 28 6c 69 73 74 3f 20 st #f #t (list?
0400: 28 6d 75 6c 74 69 2d 67 6c 6f 62 20 70 61 74 74 (multi-glob patt
0410: 29 29 29 0a 20 20 20 29 0a 20 69 6e 74 65 72 65 ))). ). intere
0420: 73 74 69 6e 67 2d 70 61 74 74 73 29 0a 0a 28 70 sting-patts)..(p
0430: 72 69 6e 74 20 22 43 6f 6d 70 61 72 65 20 74 68 rint "Compare th
0440: 65 20 67 6c 6f 62 62 65 72 73 22 29 0a 28 66 6f e globbers").(fo
0450: 72 2d 65 61 63 68 0a 20 28 6c 61 6d 62 64 61 20 r-each. (lambda
0460: 28 70 61 74 74 29 0a 20 20 20 28 67 65 6e 65 72 (patt). (gener
0470: 61 74 65 2d 70 72 65 66 69 78 20 70 61 74 74 29 ate-prefix patt)
0480: 0a 20 20 20 28 74 65 73 74 20 23 66 20 27 28 29 . (test #f '()
0490: 20 28 74 72 69 6d 2d 6c 69 73 74 0a 09 09 20 28 (trim-list... (
04a0: 6c 73 65 74 2d 78 6f 72 20 73 74 72 69 6e 67 3d lset-xor string=
04b0: 3f 20 28 70 61 74 68 2d 67 6c 6f 62 20 70 61 74 ? (path-glob pat
04c0: 74 29 28 6d 75 6c 74 69 2d 67 6c 6f 62 20 70 61 t)(multi-glob pa
04d0: 74 74 29 29 29 29 29 0a 20 69 6e 74 65 72 65 73 tt))))). interes
04e0: 74 69 6e 67 2d 70 61 74 74 73 29 0a 0a 28 74 65 ting-patts)..(te
04f0: 73 74 2d 65 78 69 74 29 0a st-exit).