From 221a346e6132ff2558c15d843bdae891db305aa2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 24 Jul 2014 18:45:24 -0700 Subject: [PATCH] update remove-all-ext to remove-ext*; move file-extension tests to sugar module --- file.rkt | 6 +++--- tests/test-file-tools.rkt | 32 -------------------------------- 2 files changed, 3 insertions(+), 35 deletions(-) diff --git a/file.rkt b/file.rkt index 7097284..b4d47e3 100644 --- a/file.rkt +++ b/file.rkt @@ -9,8 +9,8 @@ (define+provide/contract (sourceish? x) (any/c . -> . coerce/boolean?) (define sourceish-extensions (list "svg")) - (try ((get-ext x) . in? . sourceish-extensions) - (except [exn:fail? (λ(e) #f)]))) + (with-handlers ([exn:fail? (λ(e) #f)]) + ((get-ext x) . in? . sourceish-extensions))) ;; compare directories by their exploded path elements, @@ -73,7 +73,7 @@ x #,(if (equal? stem-datum 'scribble) #'(if (x . has-ext? . 'html) ; different logic for scribble sources - (add-ext (remove-all-ext x) file-ext) + (add-ext (remove-ext* x) file-ext) #f) #'(add-ext x file-ext)))) (and result (->path result))) diff --git a/tests/test-file-tools.rkt b/tests/test-file-tools.rkt index f07c924..193cbe6 100644 --- a/tests/test-file-tools.rkt +++ b/tests/test-file-tools.rkt @@ -22,38 +22,6 @@ (check-true (has-binary-ext? "foo.MP3")) (check-false (has-binary-ext? "foo.py")) - -(define foo-path-strings '("foo" "foo.txt" "foo.bar" "foo.bar.txt")) -(define-values (foo-path foo.txt-path foo.bar-path foo.bar.txt-path) - (apply values (map ->path foo-path-strings))) -;; test the sample paths before using them for other tests -(define foo-paths (list foo-path foo.txt-path foo.bar-path foo.bar.txt-path)) -(for-each check-equal? (map ->string foo-paths) foo-path-strings) - -(check-false (has-ext? foo-path 'txt)) -(check-true (foo.txt-path . has-ext? . 'txt)) -(check-true ((->path "foo.TXT") . has-ext? . 'txt)) -(check-true (has-ext? foo.bar.txt-path 'txt)) -(check-false (foo.bar.txt-path . has-ext? . 'doc)) ; wrong extension - - -(check-equal? (get-ext (->path "foo.txt")) "txt") -(check-false (get-ext "foo")) - -(check-equal? (add-ext (string->path "foo") "txt") (string->path "foo.txt")) -(check-equal? (remove-ext foo-path) foo-path) -(check-equal? (remove-ext (->path ".foo.txt")) (->path ".foo.txt")) -(check-equal? (remove-ext foo.txt-path) foo-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-equal? (remove-all-ext foo-path) foo-path) -(check-equal? (remove-all-ext foo.txt-path) foo-path) -(check-equal? (remove-all-ext (->path ".foo.txt")) (->path ".foo.txt")) -(check-not-equal? (remove-all-ext foo.bar.txt-path) foo.bar-path) ; removes more than one ext -(check-equal? (remove-all-ext foo.bar.txt-path) foo-path) - (check-true (preproc-source? "foo.pp")) (check-false (preproc-source? "foo.bar")) (check-false (preproc-source? #f))