sugar/file.rkt

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

sugar/test/main.rkt

@@ -154,12 +154,20 @@
  (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
+ ;; 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.txt-path) foo-path)
  (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-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-false (has-binary-ext? "foo.py"))