mbutterick
/
sugar
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Labels Milestones

New Pull Request

fix #16 remove-ext and remove-ext* problem #17

Merged
lijunsong merged 1 commits from master into master 9 years ago
Conversation 1 Commits 1 Files Changed 2
2 changed files with 20 additions and 8 deletions
Show Stats Download Patch File Download Diff File

20
sugar/file.rkt
Unescape Escape View File

@ -45,8 +45,9 @@
(define+provide+safe (remove-ext x) (define+provide+safe (remove-ext x)
(pathish? . -> . path?) (pathish? . -> . path?)
;; pass through hidden files (those starting with a dot) ;; pass through hidden files (those starting with a dot)
(let ([x (->path x)]) (let* ([x (->path x)]
(if ((->string x) . starts-with? . ".") [x-name (file-name-from-path x)])
(if ((->string x-name) . starts-with? . ".")
x x
(path-replace-suffix x "")))) (path-replace-suffix x ""))))
@ -54,11 +55,14 @@
;; take all extensions off path ;; take all extensions off path
(define+provide+safe (remove-ext* x) (define+provide+safe (remove-ext* x)
(pathish? . -> . path?) (pathish? . -> . path?)
(define (remove* p)
(let ([path-with-removed-ext (path-replace-suffix p "")])
(if (equal? p path-with-removed-ext)
p
(remove* path-with-removed-ext))))
;; pass through hidden files (those starting with a dot) ;; pass through hidden files (those starting with a dot)
(let ([x (->path x)]) (let ([x (->path x)]
(if ((->string x) . starts-with? . ".") [x-name (file-name-from-path x)])
x (if ((->string x-name) . starts-with? . ".")
(let ([path-with-removed-ext (remove-ext x)])
(if (equal? x path-with-removed-ext)
x x
(remove-ext* path-with-removed-ext)))))) (remove* x))))

8
sugar/test/main.rkt
Unescape Escape View File

@ -154,12 +154,20 @@
(check-equal? (remove-ext foo.txt-path) foo-path) (check-equal? (remove-ext foo.txt-path) foo-path)
(check-equal? (remove-ext foo.bar.txt-path) foo.bar-path) (check-equal? (remove-ext foo.bar.txt-path) foo.bar-path)
(check-not-equal? (remove-ext foo.bar.txt-path) foo-path) ; does not remove all extensions (check-not-equal? (remove-ext foo.bar.txt-path) foo-path) ; does not remove all extensions
;; test remove-ext on paths that have "." prefix
(check-equal? (remove-ext (->path "./foo.txt.bar")) (->path "./foo.txt"))
(check-equal? (remove-ext (->path "../foo.txt.bar")) (->path "../foo.txt"))
(check-equal? (remove-ext (->path "/hidden/file/.foo.txt.bar")) (->path "/hidden/file/.foo.txt.bar")) ; hidden file won't change
(check-equal? (remove-ext* foo-path) foo-path) (check-equal? (remove-ext* foo-path) foo-path)
(check-equal? (remove-ext* foo.txt-path) foo-path) (check-equal? (remove-ext* foo.txt-path) foo-path)
(check-equal? (remove-ext* (->path ".foo.txt")) (->path ".foo.txt")) (check-equal? (remove-ext* (->path ".foo.txt")) (->path ".foo.txt"))
(check-not-equal? (remove-ext* foo.bar.txt-path) foo.bar-path) ; removes more than one ext (check-not-equal? (remove-ext* foo.bar.txt-path) foo.bar-path) ; removes more than one ext
(check-equal? (remove-ext* foo.bar.txt-path) foo-path) (check-equal? (remove-ext* foo.bar.txt-path) foo-path)
;; test remove-ext* on paths that have "." prefix
(check-equal? (remove-ext* (->path "./foo.txt.bar")) (->path "./foo"))
(check-equal? (remove-ext* (->path "../foo.txt.bar")) (->path "../foo"))
(check-equal? (remove-ext* (->path "/hidden/file/.foo.txt.bar")) (->path "/hidden/file/.foo.txt.bar")) ; hidden file won't change
(check-true (has-binary-ext? "foo.MP3")) (check-true (has-binary-ext? "foo.MP3"))
(check-false (has-binary-ext? "foo.py")) (check-false (has-binary-ext? "foo.py"))

Write Preview
Loading…
Cancel
Save