file: Better support for trailing slashes in pathnames

e.g. file tail /abc/def/ => def

Signed-off-by: Steve Bennett <steveb@workware.net.au>

3 files changed, 201 insertions, 91 deletions

diff --git a/jim-file.c b/jim-file.c
index dca906d..f47e236 100644
--- a/jim-file.c
+++ b/jim-file.c
@@ -215,9 +215,43 @@ static int StoreStatData(Jim_Interp *interp, Jim_Obj *varName, const struct stat
     return JIM_OK;
 }
 
+/**
+ * Give a path of length 'len', returns the length of the path
+ * with any trailing slashes removed.
+ */
+static int JimPathLenNoTrailingSlashes(const char *path, int len)
+{
+    int i;
+    for (i = len; i > 1 && path[i - 1] == '/'; i--) {
+        /* Trailing slash, so remove it */
+        if (ISWINDOWS && path[i - 2] == ':') {
+            /* But on windows, we won't remove the trailing slash from c:/ */
+            break;
+        }
+    }
+    return i;
+}
+
+/**
+ * Give a path in objPtr, returns a new path with any trailing slash removed.
+ * Use Jim_DecrRefCount() on the returned object (which may be identical to objPtr).
+ */
+static Jim_Obj *JimStripTrailingSlashes(Jim_Interp *interp, Jim_Obj *objPtr)
+{
+    int len = Jim_Length(objPtr);
+    const char *path = Jim_String(objPtr);
+    int i = JimPathLenNoTrailingSlashes(path, len);
+    if (i != len) {
+        objPtr = Jim_NewStringObj(interp, path, i);
+    }
+    Jim_IncrRefCount(objPtr);
+    return objPtr;
+}
+
 static int file_cmd_dirname(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
-    const char *path = Jim_String(argv[0]);
+    Jim_Obj *objPtr = JimStripTrailingSlashes(interp, argv[0]);
+    const char *path = Jim_String(objPtr);
     const char *p = strrchr(path, '/');
 
     if (!p && path[0] == '.' && path[1] == '.' && path[2] == '\0') {
@@ -233,29 +267,35 @@ static int file_cmd_dirname(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
         Jim_SetResultString(interp, path, p - path + 1);
     }
     else {
-        Jim_SetResultString(interp, path, p - path);
+        /* Strip any trailing slashes from the result */
+        int len = JimPathLenNoTrailingSlashes(path, p - path);
+        Jim_SetResultString(interp, path, len);
     }
+    Jim_DecrRefCount(interp, objPtr);
     return JIM_OK;
 }
 
 static int file_cmd_rootname(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
-    const char *path = Jim_String(argv[0]);
+    Jim_Obj *objPtr = JimStripTrailingSlashes(interp, argv[0]);
+    const char *path = Jim_String(objPtr);
     const char *lastSlash = strrchr(path, '/');
     const char *p = strrchr(path, '.');
 
     if (p == NULL || (lastSlash != NULL && lastSlash > p)) {
-        Jim_SetResult(interp, argv[0]);
+        Jim_SetResult(interp, objPtr);
     }
     else {
         Jim_SetResultString(interp, path, p - path);
     }
+    Jim_DecrRefCount(interp, objPtr);
     return JIM_OK;
 }
 
 static int file_cmd_extension(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
-    const char *path = Jim_String(argv[0]);
+    Jim_Obj *objPtr = JimStripTrailingSlashes(interp, argv[0]);
+    const char *path = Jim_String(objPtr);
     const char *lastSlash = strrchr(path, '/');
     const char *p = strrchr(path, '.');
 
@@ -263,20 +303,23 @@ static int file_cmd_extension(Jim_Interp *interp, int argc, Jim_Obj *const *argv
         p = "";
     }
     Jim_SetResultString(interp, p, -1);
+    Jim_DecrRefCount(interp, objPtr);
     return JIM_OK;
 }
 
 static int file_cmd_tail(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
-    const char *path = Jim_String(argv[0]);
+    Jim_Obj *objPtr = JimStripTrailingSlashes(interp, argv[0]);
+    const char *path = Jim_String(objPtr);
     const char *lastSlash = strrchr(path, '/');
 
     if (lastSlash) {
         Jim_SetResultString(interp, lastSlash + 1, -1);
     }
     else {
-        Jim_SetResult(interp, argv[0]);
+        Jim_SetResult(interp, objPtr);
     }
+    Jim_DecrRefCount(interp, objPtr);
     return JIM_OK;
 }
 
diff --git a/tests/file.test b/tests/file.test
new file mode 100644
index 0000000..10211cd
--- /dev/null
+++ b/tests/file.test
@@ -0,0 +1,151 @@
+source [file dirname [info script]]/testing.tcl
+
+needs cmd file
+
+test join-1.1 "One name" {
+	file join abc
+} {abc}
+
+test join-1.2 "One name with trailing slash" {
+	file join abc/
+} {abc}
+
+test join-1.3 "One name with leading slash" {
+	file join /abc
+} {/abc}
+
+test join-1.4 "One name with leading and trailing slash" {
+	file join /abc/
+} {/abc}
+
+test join-1.5 "Two names" {
+	file join abc def
+} {abc/def}
+
+test join-1.6 "Two names with dir trailing slash" {
+	file join abc/ def
+} {abc/def}
+
+test join-1.7 "Two names with dir leading slash" {
+	file join /abc def
+} {/abc/def}
+
+test join-1.8 "Two names with dir leading and trailing slash" {
+	file join /abc/ def
+} {/abc/def}
+
+test join-1.9 "Two names with file trailing slash" {
+	file join abc def/
+} {abc/def}
+
+test join-1.10 "Two names with file leading slash" {
+	file join abc /def
+} {/def}
+
+test join-1.11 "Two names with file leading and trailing slash" {
+	file join abc /def/
+} {/def}
+
+test join-1.12 "Two names with double slashes" {
+	file join abc/ /def
+} {/def}
+
+test join-1.13 "Join to root" {
+	file join / abc
+} {/abc}
+
+test join-1.14 "Join to root" {
+	set dir [file join / .]
+	# Either / or /. is OK here
+	expr {$dir in {/ /.}}
+} 1
+
+test join-1.15 "Join to root" {
+	file join / /
+} {/}
+
+test join-1.16 "Join to root" {
+	file join /abc /
+} {/}
+
+test join-1.17 "With trailing slash" {
+	file join /abc/def/ ghi/jkl
+} {/abc/def/ghi/jkl}
+
+test join-2.1 "Dir is empty string" {
+	file join "" def
+} {def}
+
+test join-2.2 "File is empty string" {
+	file join abc ""
+} {abc}
+
+test join-2.3 "Path too long" jim {
+	set components [string repeat {abcdefghi } 500]
+	list [catch [concat file join $components] msg] $msg
+} {1 {Path too long}}
+
+test tail-1.1 "One component" {
+	file tail abc
+} {abc}
+
+test tail-1.2 "Two components" {
+	file tail abc/def
+} {def}
+
+test tail-1.3 "Absolute one component" {
+	file tail /abc
+} {abc}
+
+test tail-1.4 "Trailing slash" {
+	file tail abc/
+} {abc}
+
+test dirname-1.1 "One component" {
+	file dirname abc
+} {.}
+
+test dirname-1.2 "Two components" {
+	file dirname abc/def
+} {abc}
+
+test dirname-1.3 "Absolute one component" {
+	file dirname /abc
+} {/}
+
+test dirname-1.4 "Trailing slash" {
+	file dirname abc/
+} {.}
+
+# These tests are courtesy of picol
+
+test file.12.1 "picol test" {file dirname /foo/bar/grill.txt}  /foo/bar
+test file.12.2 "picol test" {file dirname /foo/bar/baz/}       /foo/bar
+test file.12.3 "picol test" {file dirname /foo/bar/baz///}     /foo/bar
+test file.12.4 "picol test" {file dirname /foo/bar/baz///qux}  /foo/bar/baz
+test file.12.5 "picol test" {file dirname foo/bar/grill.txt}   foo/bar
+test file.12.6 "picol test" {file dirname foo/bar/baz/}        foo/bar
+test file.12.7 "picol test" {file dirname {}}    .
+test file.12.8 "picol test" {file dirname /}     /
+test file.12.9 "picol test" {file dirname ///}   /
+
+test file.13.1 "picol test" {file tail /foo/bar/grill.txt}   grill.txt
+test file.13.2 "picol test" {file tail /foo/bar/baz/}        baz
+test file.13.3 "picol test" {file tail /foo/bar/baz///}      baz
+test file.13.4 "picol test" {file dirname /foo/bar/baz///qux}  /foo/bar/baz
+test file.13.5 "picol test" {file tail foo/bar/grill.txt}    grill.txt
+test file.13.6 "picol test" {file tail foo/bar/baz/}         baz
+test file.13.7 "picol test" {file tail {}}    {}
+test file.13.8 "picol test" {file tail /}     {}
+test file.13.9 "picol test" {file tail ///}   {}
+
+test file.14   "picol test" {file join foo}               foo
+test file.15   "picol test" {file join foo bar}           foo/bar
+test file.16   "picol test" {file join foo /bar}          /bar
+
+if {$tcl_platform(platform) eq {windows}} {
+    test file.17  "picol test" {file join foo C:/bar grill}  C:/bar/grill
+}
+
+
+testreport
diff --git a/tests/filejoin.test b/tests/filejoin.test
deleted file mode 100644
index 7245938..0000000
--- a/tests/filejoin.test
+++ /dev/null
@@ -1,84 +0,0 @@
-source [file dirname [info script]]/testing.tcl
-
-needs cmd file
-
-test join-1.1 "One name" {
-	file join abc
-} {abc}
-
-test join-1.2 "One name with trailing slash" {
-	file join abc/
-} {abc}
-
-test join-1.3 "One name with leading slash" {
-	file join /abc
-} {/abc}
-
-test join-1.4 "One name with leading and trailing slash" {
-	file join /abc/
-} {/abc}
-
-test join-1.5 "Two names" {
-	file join abc def
-} {abc/def}
-
-test join-1.6 "Two names with dir trailing slash" {
-	file join abc/ def
-} {abc/def}
-
-test join-1.7 "Two names with dir leading slash" {
-	file join /abc def
-} {/abc/def}
-
-test join-1.8 "Two names with dir leading and trailing slash" {
-	file join /abc/ def
-} {/abc/def}
-
-test join-1.9 "Two names with file trailing slash" {
-	file join abc def/
-} {abc/def}
-
-test join-1.10 "Two names with file leading slash" {
-	file join abc /def
-} {/def}
-
-test join-1.11 "Two names with file leading and trailing slash" {
-	file join abc /def/
-} {/def}
-
-test join-1.12 "Two names with double slashes" {
-	file join abc/ /def
-} {/def}
-
-test join-1.13 "Join to root" {
-	file join / abc
-} {/abc}
-
-test join-1.14 "Join to root" {
-	set dir [file join / .]
-	# Either / or /. is OK here
-	expr {$dir in {/ /.}}
-} 1
-
-test join-1.15 "Join to root" {
-	file join / /
-} {/}
-
-test join-1.16 "Join to root" {
-	file join /abc /
-} {/}
-
-test join-2.1 "Dir is empty string" {
-	file join "" def
-} {def}
-
-test join-2.2 "File is empty string" {
-	file join abc ""
-} {abc}
-
-test join-2.3 "Path too long" jim {
-	set components [string repeat {abcdefghi } 500]
-	list [catch [concat file join $components] msg] $msg
-} {1 {Path too long}}
-
-testreport