Changeset 25923 in project

Timestamp:

02/19/12 04:46:02 (9 years ago)

Author:

Ivan Raikov

Message:

filepath: fixed a bug in is-relative-drive (thanks to Christian Kellermann for reporting the issue)

Location:

release/4/filepath/trunk

Files:

• filepath.scm (modified) (1 diff)
• filepath.setup (modified) (1 diff)
• tests/run.scm (modified) (1 diff)

release/4/filepath/trunk/filepath.scm

@@ -625 +625 @@
 
 (define (is-relative-drive? p)
-  (not (is-path-separator? (last (first (read-drive-letter p))))))
+  (or (null? p)
+      (let ((p1 (read-drive-letter p)))
+        (not (is-path-separator? (or (and p1 (last (first p1)))
+                                     (first p))))
+        )))
 
 (define (is-absolute? p)

release/4/filepath/trunk/filepath.setup

@@ -16 +16 @@
 
   ;; Assoc list with properties for your extension:
-  '((version 1.3)
+  '((version 1.5)
     ))
 

release/4/filepath/trunk/tests/run.scm

@@ -252 +252 @@
             )
 
+(test-group "is-relative?"
+            (filepath:posix #f)
+            (test-assert (filepath:is-relative? ""))
+            (test-assert (filepath:is-relative? "path\\test"))
+            (test-assert (not (filepath:is-relative? "c:\\test")))
+            (test-assert (filepath:is-relative? "c:test"))
+            (test-assert (filepath:is-relative? "c:"))
+            (test-assert (not (filepath:is-relative? "\\\\foo")))
+            (test-assert (filepath:is-relative? "/foo"))
+            (filepath:posix #t)
+            (test-assert (filepath:is-relative? "test/path"))
+            (test-assert (not (filepath:is-relative? "/test")))
+            )
+            
+
 (test-exit)