fix to 'file dirname' and to fs refCount documentation

4 files changed, 65 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index 9c28462..5a3b426 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2004-05-17  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* generic/tclPathObj.c: fix to (Bug 956063) in 'file dirname'.
+	* tests/cmdAH.test: added test for this bug.
+
+	* doc/FileSystem.3: better documentation of refCount requirements 
+	of some FS functions (Bug 956126)
+
 2004-05-19  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* generic/tclTest.c (TestgetintCmd): Made the tests in get.test check
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index 74cdf01..0162c4d 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: FileSystem.3,v 1.42 2004/04/23 12:09:37 vincentdarley Exp $
+'\" RCS: @(#) $Id: FileSystem.3,v 1.43 2004/05/19 16:56:39 vincentdarley Exp $
 '\" 
 .so man.macros
 .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
@@ -503,7 +503,14 @@ The separator is returned as a Tcl_Obj containing a string of length
 \fBTcl_FSJoinPath\fR takes the given Tcl_Obj, which must be a valid
 list (which is allowed to have a refCount of zero), and returns the path
 object given by considering the first 'elements' elements as valid path
-segments.  If elements < 0, we use the entire list.
+segments (each path segment may be a complete path, a partial path or
+just a single possible directory or file name).  If any path segment is
+actually an absolute path, then all prior path segments are discarded.
+If elements < 0, we use the entire list.
+.PP
+It is possible that the returned object is actually an element
+of the given list, so the caller should be careful to store a
+refCount to it before freeing the list.
 .PP
 Returns object, typically with refCount of zero (but it could be shared
 under some conditions) , containing the joined path.  The caller must
@@ -1118,11 +1125,13 @@ typedef Tcl_Obj* Tcl_FSLinkProc(
 If \fItoPtr\fR is NULL, the function is being asked to read the
 contents of a link.  The result is a Tcl_Obj specifying the contents of
 the link given by \fIlinkNamePtr\fR, or NULL if the link could
-not be read.  The result is owned by the caller, which should call
-Tcl_DecrRefCount when the result is no longer needed.  If \fItoPtr\fR 
-is not NULL, the function should attempt to create a link.  The result
-in this case should be \fItoPtr\fR if the link was successful and NULL
-otherwise.  In this case the result is not owned by the caller. See
+not be read.  The result is owned by the caller (and should therefore
+have its ref count incremented before being returned).  Any callers
+should call Tcl_DecrRefCount on this result when it is no longer needed.  
+If \fItoPtr\fR is not NULL, the function should attempt to create a link.  
+The result in this case should be \fItoPtr\fR if the link was successful 
+and NULL otherwise.  In this case the result is not owned by the caller
+(i.e. no ref count manipulation on either end is needed). See
 the documentation for \fBTcl_FSLink\fR for the correct interpretation
 of the \fIlinkAction\fR flags.
 .SH LISTVOLUMESPROC	    
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index bcb1500..df9963a 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclPathObj.c,v 1.30 2004/04/23 12:09:37 vincentdarley Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.31 2004/05/19 16:56:39 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -494,6 +494,26 @@ TclPathPart(interp, pathPtr, portion)
 	if (PATHFLAGS(pathPtr) != 0) {
 	    switch (portion) {
 		case TCL_PATH_DIRNAME: {
+		    /* 
+		     * Check if the joined-on bit has any directory
+		     * delimiters in it.  If so, the 'dirname' would
+		     * be a joining of the main part with the dirname
+		     * of the joined-on bit.  We could handle that
+		     * special case here, but we don't, and instead
+		     * just use the standardPath code.
+		     */
+		    CONST char *rest = Tcl_GetString(fsPathPtr->normPathPtr);
+		    if (strchr(rest, '/') != NULL) {
+			goto standardPath;
+		    }
+		    if ((tclPlatform == TCL_PLATFORM_WINDOWS) 
+		      && (strchr(rest, '\\') != NULL)) {
+			goto standardPath;
+		    }
+		    /* 
+		     * The joined-on path is simple, so we can just
+		     * return here.
+		     */
 		    Tcl_IncrRefCount(fsPathPtr->cwdPtr);
 		    return fsPathPtr->cwdPtr;
 		}
@@ -662,8 +682,13 @@ GetExtension(pathPtr)
  *
  *      This function takes the given Tcl_Obj, which should be a valid
  *      list, and returns the path object given by considering the
- *      first 'elements' elements as valid path segments.  If elements < 0,
- *      we use the entire list.
+ *      first 'elements' elements as valid path segments (each path
+ *      segment may be a complete path, a partial path or just a single
+ *      possible directory or file name).   If any path segment is
+ *      actually an absolute path, then all prior path segments are 
+ *      discarded.
+ *      
+ *      If elements < 0, we use the entire list that was given.
  *      
  *      It is possible that the returned object is actually an element
  *      of the given list, so the caller should be careful to store a
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index c66fc82..41fef8d 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdAH.test,v 1.40 2004/05/17 10:38:22 vincentdarley Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.41 2004/05/19 16:56:40 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -367,6 +367,18 @@ test cmdAH-8.45 {Tcl_FileObjCmd: dirname} testsetplatform {
     set env(HOME) $temp
     set result
 } {0 /homewontexist}
+test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {
+    set f [file normalize [info nameof]]
+    file exists $f
+    set res1 [file dirname [file join $f foo/bar]]
+    set res2 [file dirname "${f}/foo/bar"]
+    if {$res1 eq $res2} {
+	set res "ok"
+    } else {
+        set res "file dirname problem, $res1, $res2 not equal"
+    }
+    set res
+} {ok}
 
 # tail