1/*
2 * tclPathObj.c --
3 *
4 *	This file contains the implementation of Tcl's "path" object type used
5 *	to represent and manipulate a general (virtual) filesystem entity in
6 *	an efficient manner.
7 *
8 * Copyright (c) 2003 Vince Darley.
9 *
10 * See the file "license.terms" for information on usage and redistribution of
11 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tclPathObj.c,v 1.66.2.12 2010/05/21 12:18:17 nijtmans Exp $
14 */
15
16#include "tclInt.h"
17#include "tclFileSystem.h"
18
19/*
20 * Prototypes for functions defined later in this file.
21 */
22
23static Tcl_Obj *	AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
24static void		DupFsPathInternalRep(Tcl_Obj *srcPtr,
25			    Tcl_Obj *copyPtr);
26static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
27static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
28static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
29static int		FindSplitPos(const char *path, int separator);
30static int		IsSeparatorOrNull(int ch);
31static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
32
33/*
34 * Define the 'path' object type, which Tcl uses to represent file paths
35 * internally.
36 */
37
38static Tcl_ObjType tclFsPathType = {
39    "path",				/* name */
40    FreeFsPathInternalRep,		/* freeIntRepProc */
41    DupFsPathInternalRep,		/* dupIntRepProc */
42    UpdateStringOfFsPath,		/* updateStringProc */
43    SetFsPathFromAny			/* setFromAnyProc */
44};
45
46/*
47 * struct FsPath --
48 *
49 * Internal representation of a Tcl_Obj of "path" type. This can be used to
50 * represent relative or absolute paths, and has certain optimisations when
51 * used to represent paths which are already normalized and absolute.
52 *
53 * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular
54 * reference to the container Tcl_Obj of this FsPath.
55 *
56 * There are two cases, with the first being the most common:
57 *
58 * (i) flags == 0, => Ordinary path.
59 *
60 * translatedPathPtr contains the translated path (which may be a circular
61 * reference to the object itself). If it is NULL then the path is pure
62 * normalized (and the normPathPtr will be a circular reference). cwdPtr is
63 * null for an absolute path, and non-null for a relative path (unless the cwd
64 * has never been set, in which case the cwdPtr may also be null for a
65 * relative path).
66 *
67 * (ii) flags != 0, => Special path, see TclNewFSPathObj
68 *
69 * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir
70 * and normPathPtr is the $tail.
71 *
72 */
73
74typedef struct FsPath {
75    Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
76				 * is NULL, then this is a pure normalized,
77				 * absolute path object, in which the parent
78				 * Tcl_Obj's string rep is already both
79				 * translated and normalized. */
80    Tcl_Obj *normPathPtr;	/* Normalized absolute path, without ., .. or
81				 * ~user sequences. If the Tcl_Obj containing
82				 * this FsPath is already normalized, this may
83				 * be a circular reference back to the
84				 * container. If that is NOT the case, we have
85				 * a refCount on the object. */
86    Tcl_Obj *cwdPtr;		/* If null, path is absolute, else this points
87				 * to the cwd object used for this path. We
88				 * have a refCount on the object. */
89    int flags;			/* Flags to describe interpretation - see
90				 * below. */
91    ClientData nativePathPtr;	/* Native representation of this path, which
92				 * is filesystem dependent. */
93    int filesystemEpoch;	/* Used to ensure the path representation was
94				 * generated during the correct filesystem
95				 * epoch. The epoch changes when
96				 * filesystem-mounts are changed. */
97    struct FilesystemRecord *fsRecPtr;
98				/* Pointer to the filesystem record entry to
99				 * use for this path. */
100} FsPath;
101
102/*
103 * Flag values for FsPath->flags.
104 */
105
106#define TCLPATH_APPENDED 1
107#define TCLPATH_NEEDNORM 4
108
109/*
110 * Define some macros to give us convenient access to path-object specific
111 * fields.
112 */
113
114#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.otherValuePtr)
115#define SETPATHOBJ(pathPtr,fsPathPtr) \
116	((pathPtr)->internalRep.otherValuePtr = (void *) (fsPathPtr))
117#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
118
119/*
120 *---------------------------------------------------------------------------
121 *
122 * TclFSNormalizeAbsolutePath --
123 *
124 *	Takes an absolute path specification and computes a 'normalized' path
125 *	from it.
126 *
127 *	A normalized path is one which has all '../', './' removed. Also it is
128 *	one which is in the 'standard' format for the native platform. On
129 *	Unix, this means the path must be free of symbolic links/aliases, and
130 *	on Windows it means we want the long form, with that long form's
131 *	case-dependence (which gives us a unique, case-dependent path).
132 *
133 *	The behaviour of this function if passed a non-absolute path is NOT
134 *	defined.
135 *
136 *	pathPtr may have a refCount of zero, or may be a shared object.
137 *
138 * Results:
139 *	The result is returned in a Tcl_Obj with a refCount of 1, which is
140 *	therefore owned by the caller. It must be freed (with
141 *	Tcl_DecrRefCount) by the caller when no longer needed.
142 *
143 * Side effects:
144 *	None (beyond the memory allocation for the result).
145 *
146 * Special note:
147 *	This code was originally based on code from Matt Newman and
148 *	Jean-Claude Wippler, but has since been totally rewritten by Vince
149 *	Darley to deal with symbolic links.
150 *
151 *---------------------------------------------------------------------------
152 */
153
154Tcl_Obj *
155TclFSNormalizeAbsolutePath(
156    Tcl_Interp *interp,		/* Interpreter to use */
157    Tcl_Obj *pathPtr,		/* Absolute path to normalize */
158    ClientData *clientDataPtr)	/* If non-NULL, then may be set to the
159				 * fs-specific clientData for this path. This
160				 * will happen when that extra information can
161				 * be calculated efficiently as a side-effect
162				 * of normalization. */
163{
164    ClientData clientData = NULL;
165    const char *dirSep, *oldDirSep;
166    int first = 1;		/* Set to zero once we've passed the first
167				 * directory separator - we can't use '..' to
168				 * remove the volume in a path. */
169    Tcl_Obj *retVal = NULL;
170    dirSep = TclGetString(pathPtr);
171
172    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
173	if (   (dirSep[0] == '/' || dirSep[0] == '\\')
174	    && (dirSep[1] == '/' || dirSep[1] == '\\')
175	    && (dirSep[2] == '?')
176	    && (dirSep[3] == '/' || dirSep[3] == '\\')) {
177	    /* NT extended path */
178	    dirSep += 4;
179
180	    if (   (dirSep[0] == 'U' || dirSep[0] == 'u')
181		&& (dirSep[1] == 'N' || dirSep[1] == 'n')
182		&& (dirSep[2] == 'C' || dirSep[2] == 'c')
183		&& (dirSep[3] == '/' || dirSep[3] == '\\')) {
184		/* NT extended UNC path */
185		dirSep += 4;
186	    }
187	}
188	if (dirSep[0] != 0 && dirSep[1] == ':' &&
189		(dirSep[2] == '/' || dirSep[2] == '\\')) {
190	    /* Do nothing */
191	} else if ((dirSep[0] == '/' || dirSep[0] == '\\')
192		&& (dirSep[1] == '/' || dirSep[1] == '\\')) {
193	    /*
194	     * UNC style path, where we must skip over the first separator,
195	     * since the first two segments are actually inseparable.
196	     */
197
198	    dirSep += 2;
199	    dirSep += FindSplitPos(dirSep, '/');
200	    if (*dirSep != 0) {
201		dirSep++;
202	    }
203	}
204    }
205
206    /*
207     * Scan forward from one directory separator to the next, checking for
208     * '..' and '.' sequences which must be handled specially. In particular
209     * handling of '..' can be complicated if the directory before is a link,
210     * since we will have to expand the link to be able to back up one level.
211     */
212
213    while (*dirSep != 0) {
214	oldDirSep = dirSep;
215	if (!first) {
216	    dirSep++;
217	}
218	dirSep += FindSplitPos(dirSep, '/');
219	if (dirSep[0] == 0 || dirSep[1] == 0) {
220	    if (retVal != NULL) {
221		Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
222	    }
223	    break;
224	}
225	if (dirSep[1] == '.') {
226	    if (retVal != NULL) {
227		Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
228		oldDirSep = dirSep;
229	    }
230	again:
231	    if (IsSeparatorOrNull(dirSep[2])) {
232		/*
233		 * Need to skip '.' in the path.
234		 */
235		int curLen;
236
237		if (retVal == NULL) {
238		    const char *path = TclGetString(pathPtr);
239		    retVal = Tcl_NewStringObj(path, dirSep - path);
240		    Tcl_IncrRefCount(retVal);
241		}
242		(void) Tcl_GetStringFromObj(retVal, &curLen);
243		if (curLen == 0) {
244		    Tcl_AppendToObj(retVal, dirSep, 1);
245		}
246		dirSep += 2;
247		oldDirSep = dirSep;
248		if (dirSep[0] != 0 && dirSep[1] == '.') {
249		    goto again;
250		}
251		continue;
252	    }
253	    if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
254		Tcl_Obj *link;
255		int curLen;
256		char *linkStr;
257
258		/*
259		 * Have '..' so need to skip previous directory.
260		 */
261
262		if (retVal == NULL) {
263		    const char *path = TclGetString(pathPtr);
264
265		    retVal = Tcl_NewStringObj(path, dirSep - path);
266		    Tcl_IncrRefCount(retVal);
267		}
268		(void) Tcl_GetStringFromObj(retVal, &curLen);
269		if (curLen == 0) {
270		    Tcl_AppendToObj(retVal, dirSep, 1);
271		}
272		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
273		    link = Tcl_FSLink(retVal, NULL, 0);
274		    if (link != NULL) {
275			/*
276			 * Got a link. Need to check if the link is relative
277			 * or absolute, for those platforms where relative
278			 * links exist.
279			 */
280
281			if (tclPlatform != TCL_PLATFORM_WINDOWS &&
282				Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE) {
283			    /*
284			     * We need to follow this link which is relative
285			     * to retVal's directory. This means concatenating
286			     * the link onto the directory of the path so far.
287			     */
288
289			    const char *path =
290				    Tcl_GetStringFromObj(retVal, &curLen);
291
292			    while (--curLen >= 0) {
293				if (IsSeparatorOrNull(path[curLen])) {
294				    break;
295				}
296			    }
297			    if (Tcl_IsShared(retVal)) {
298				TclDecrRefCount(retVal);
299				retVal = Tcl_DuplicateObj(retVal);
300				Tcl_IncrRefCount(retVal);
301			    }
302
303			    /*
304			     * We want the trailing slash.
305			     */
306
307			    Tcl_SetObjLength(retVal, curLen+1);
308			    Tcl_AppendObjToObj(retVal, link);
309			    TclDecrRefCount(link);
310			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
311			} else {
312			    /*
313			     * Absolute link.
314			     */
315
316			    TclDecrRefCount(retVal);
317			    retVal = link;
318			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
319
320			    /*
321			     * Convert to forward-slashes on windows.
322			     */
323
324			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
325				int i;
326
327				for (i = 0; i < curLen; i++) {
328				    if (linkStr[i] == '\\') {
329					linkStr[i] = '/';
330				    }
331				}
332			    }
333			}
334		    } else {
335			linkStr = Tcl_GetStringFromObj(retVal, &curLen);
336		    }
337
338		    /*
339		     * Either way, we now remove the last path element.
340		     * (but not the first character of the path)
341		     */
342
343		    while (--curLen >= 0) {
344			if (IsSeparatorOrNull(linkStr[curLen])) {
345			    if (curLen) {
346				Tcl_SetObjLength(retVal, curLen);
347			    } else {
348				Tcl_SetObjLength(retVal, 1);
349			    }
350			    break;
351			}
352		    }
353		}
354		dirSep += 3;
355		oldDirSep = dirSep;
356
357		if ((curLen == 0) && (dirSep[0] != 0)) {
358		    Tcl_SetObjLength(retVal, 0);
359		}
360
361		if (dirSep[0] != 0 && dirSep[1] == '.') {
362		    goto again;
363		}
364		continue;
365	    }
366	}
367	first = 0;
368	if (retVal != NULL) {
369	    Tcl_AppendToObj(retVal, oldDirSep, dirSep - oldDirSep);
370	}
371    }
372
373    /*
374     * If we didn't make any changes, just use the input path.
375     */
376
377    if (retVal == NULL) {
378	retVal = pathPtr;
379	Tcl_IncrRefCount(retVal);
380
381	if (Tcl_IsShared(retVal)) {
382	    /*
383	     * Unfortunately, the platform-specific normalization code which
384	     * will be called below has no way of dealing with the case where
385	     * an object is shared. It is expecting to modify an object in
386	     * place. So, we must duplicate this here to ensure an object with
387	     * a single ref-count.
388	     *
389	     * If that changes in the future (e.g. the normalize proc is given
390	     * one object and is able to return a different one), then we
391	     * could remove this code.
392	     */
393
394	    TclDecrRefCount(retVal);
395	    retVal = Tcl_DuplicateObj(pathPtr);
396	    Tcl_IncrRefCount(retVal);
397	}
398    }
399
400    /*
401     * Ensure a windows drive like C:/ has a trailing separator
402     */
403
404    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
405	int len;
406	const char *path = Tcl_GetStringFromObj(retVal, &len);
407
408	if (len == 2 && path[0] != 0 && path[1] == ':') {
409	    if (Tcl_IsShared(retVal)) {
410		TclDecrRefCount(retVal);
411		retVal = Tcl_DuplicateObj(retVal);
412		Tcl_IncrRefCount(retVal);
413	    }
414	    Tcl_AppendToObj(retVal, "/", 1);
415	}
416    }
417
418    /*
419     * Now we have an absolute path, with no '..', '.' sequences, but it still
420     * may not be in 'unique' form, depending on the platform. For instance,
421     * Unix is case-sensitive, so the path is ok. Windows is case-insensitive,
422     * and also has the weird 'longname/shortname' thing (e.g. C:/Program
423     * Files/ and C:/Progra~1/ are equivalent).
424     *
425     * Virtual file systems which may be registered may have other criteria
426     * for normalizing a path.
427     */
428
429    TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData);
430
431    /*
432     * Since we know it is a normalized path, we can actually convert this
433     * object into an FsPath for greater efficiency
434     */
435
436    TclFSMakePathFromNormalized(interp, retVal, clientData);
437    if (clientDataPtr != NULL) {
438	*clientDataPtr = clientData;
439    }
440
441    /*
442     * This has a refCount of 1 for the caller, unlike many Tcl_Obj APIs.
443     */
444
445    return retVal;
446}
447
448/*
449 *----------------------------------------------------------------------
450 *
451 * Tcl_FSGetPathType --
452 *
453 *	Determines whether a given path is relative to the current directory,
454 *	relative to the current volume, or absolute.
455 *
456 * Results:
457 *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
458 *	TCL_PATH_VOLUME_RELATIVE.
459 *
460 * Side effects:
461 *	None.
462 *
463 *----------------------------------------------------------------------
464 */
465
466Tcl_PathType
467Tcl_FSGetPathType(
468    Tcl_Obj *pathPtr)
469{
470    return TclFSGetPathType(pathPtr, NULL, NULL);
471}
472
473/*
474 *----------------------------------------------------------------------
475 *
476 * TclFSGetPathType --
477 *
478 *	Determines whether a given path is relative to the current directory,
479 *	relative to the current volume, or absolute. If the caller wishes to
480 *	know which filesystem claimed the path (in the case for which the path
481 *	is absolute), then a reference to a filesystem pointer can be passed
482 *	in (but passing NULL is acceptable).
483 *
484 * Results:
485 *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
486 *	TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
487 *	only if it is non-NULL and the function's return value is
488 *	TCL_PATH_ABSOLUTE.
489 *
490 * Side effects:
491 *	None.
492 *
493 *----------------------------------------------------------------------
494 */
495
496Tcl_PathType
497TclFSGetPathType(
498    Tcl_Obj *pathPtr,
499    Tcl_Filesystem **filesystemPtrPtr,
500    int *driveNameLengthPtr)
501{
502    FsPath *fsPathPtr;
503
504    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
505	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
506		NULL);
507    }
508
509    fsPathPtr = PATHOBJ(pathPtr);
510    if (fsPathPtr->cwdPtr == NULL) {
511	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
512		NULL);
513    }
514
515    if (PATHFLAGS(pathPtr) == 0) {
516	/* The path is not absolute... */
517#ifdef __WIN32__
518	/* ... on Windows we must make another call to determine whether
519	 * it's relative or volumerelative [Bug 2571597]. */
520	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
521		NULL);
522#else
523	/* On other systems, quickly deduce !absolute -> relative */
524	return TCL_PATH_RELATIVE;
525#endif
526    }
527    return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr,
528	    driveNameLengthPtr);
529}
530
531/*
532 *---------------------------------------------------------------------------
533 *
534 * TclPathPart
535 *
536 *	This function calculates the requested part of the given path, which
537 *	can be:
538 *
539 *	- the directory above ('file dirname')
540 *	- the tail            ('file tail')
541 *	- the extension       ('file extension')
542 *	- the root            ('file root')
543 *
544 *	The 'portion' parameter dictates which of these to calculate. There
545 *	are a number of special cases both to be more efficient, and because
546 *	the behaviour when given a path with only a single element is defined
547 *	to require the expansion of that single element, where possible.
548 *
549 *	Should look into integrating 'FileBasename' in tclFCmd.c into this
550 *	function.
551 *
552 * Results:
553 *	NULL if an error occurred, otherwise a Tcl_Obj owned by the caller
554 *	(i.e. most likely with refCount 1).
555 *
556 * Side effects:
557 *	None.
558 *
559 *---------------------------------------------------------------------------
560 */
561
562Tcl_Obj *
563TclPathPart(
564    Tcl_Interp *interp,		/* Used for error reporting */
565    Tcl_Obj *pathPtr,		/* Path to take dirname of */
566    Tcl_PathPart portion)	/* Requested portion of name */
567{
568    if (pathPtr->typePtr == &tclFsPathType) {
569	FsPath *fsPathPtr = PATHOBJ(pathPtr);
570
571	if (TclFSEpochOk(fsPathPtr->filesystemEpoch)
572		&& (PATHFLAGS(pathPtr) != 0)) {
573	    switch (portion) {
574	    case TCL_PATH_DIRNAME: {
575		/*
576		 * Check if the joined-on bit has any directory delimiters in
577		 * it. If so, the 'dirname' would be a joining of the main
578		 * part with the dirname of the joined-on bit. We could handle
579		 * that special case here, but we don't, and instead just use
580		 * the standardPath code.
581		 */
582
583		int numBytes;
584		const char *rest =
585			Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
586
587		if (strchr(rest, '/') != NULL) {
588		    goto standardPath;
589		}
590		/*
591		 * If the joined-on bit is empty, then [file dirname] is
592		 * documented to return all but the last non-empty element
593		 * of the path, so we need to split apart the main part to
594		 * get the right answer.  We could do that here, but it's
595		 * simpler to fall back to the standardPath code.
596		 * [Bug 2710920]
597		 */
598		if (numBytes == 0) {
599		    goto standardPath;
600		}
601		if (tclPlatform == TCL_PLATFORM_WINDOWS
602			&& strchr(rest, '\\') != NULL) {
603		    goto standardPath;
604		}
605
606		/*
607		 * The joined-on path is simple, so we can just return here.
608		 */
609
610		Tcl_IncrRefCount(fsPathPtr->cwdPtr);
611		return fsPathPtr->cwdPtr;
612	    }
613	    case TCL_PATH_TAIL: {
614		/*
615		 * Check if the joined-on bit has any directory delimiters in
616		 * it. If so, the 'tail' would be only the part following the
617		 * last delimiter. We could handle that special case here, but
618		 * we don't, and instead just use the standardPath code.
619		 */
620
621		int numBytes;
622		const char *rest =
623			Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
624
625		if (strchr(rest, '/') != NULL) {
626		    goto standardPath;
627		}
628		/*
629		 * If the joined-on bit is empty, then [file tail] is
630		 * documented to return the last non-empty element
631		 * of the path, so we need to split off the last element
632		 * of the main part to get the right answer.  We could do
633		 * that here, but it's simpler to fall back to the
634		 * standardPath code.  [Bug 2710920]
635		 */
636		if (numBytes == 0) {
637		    goto standardPath;
638		}
639		if (tclPlatform == TCL_PLATFORM_WINDOWS
640			&& strchr(rest, '\\') != NULL) {
641		    goto standardPath;
642		}
643		Tcl_IncrRefCount(fsPathPtr->normPathPtr);
644		return fsPathPtr->normPathPtr;
645	    }
646	    case TCL_PATH_EXTENSION:
647		return GetExtension(fsPathPtr->normPathPtr);
648	    case TCL_PATH_ROOT: {
649		const char *fileName, *extension;
650		int length;
651
652		fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
653			&length);
654		extension = TclGetExtension(fileName);
655		if (extension == NULL) {
656		    /*
657		     * There is no extension so the root is the same as the
658		     * path we were given.
659		     */
660
661		    Tcl_IncrRefCount(pathPtr);
662		    return pathPtr;
663		} else {
664		    /*
665		     * Need to return the whole path with the extension
666		     * suffix removed.  Do that by joining our "head" to
667		     * our "tail" with the extension suffix removed from
668		     * the tail.
669		     */
670
671		    Tcl_Obj *resultPtr =
672			    TclNewFSPathObj(fsPathPtr->cwdPtr, fileName,
673			    (int)(length - strlen(extension)));
674
675		    Tcl_IncrRefCount(resultPtr);
676		    return resultPtr;
677		}
678	    }
679	    default:
680		/* We should never get here */
681		Tcl_Panic("Bad portion to TclPathPart");
682		/* For less clever compilers */
683		return NULL;
684	    }
685	} else if (fsPathPtr->cwdPtr != NULL) {
686	    /* Relative path */
687	    goto standardPath;
688	} else {
689	    /* Absolute path */
690	    goto standardPath;
691	}
692    } else {
693	int splitElements;
694	Tcl_Obj *splitPtr, *resultPtr;
695
696    standardPath:
697	resultPtr = NULL;
698	if (portion == TCL_PATH_EXTENSION) {
699	    return GetExtension(pathPtr);
700	} else if (portion == TCL_PATH_ROOT) {
701	    int length;
702	    const char *fileName, *extension;
703
704	    fileName = Tcl_GetStringFromObj(pathPtr, &length);
705	    extension = TclGetExtension(fileName);
706	    if (extension == NULL) {
707		Tcl_IncrRefCount(pathPtr);
708		return pathPtr;
709	    } else {
710		Tcl_Obj *root = Tcl_NewStringObj(fileName,
711			(int) (length - strlen(extension)));
712
713		Tcl_IncrRefCount(root);
714		return root;
715	    }
716	}
717
718	/*
719	 * The behaviour we want here is slightly different to the standard
720	 * Tcl_FSSplitPath in the handling of home directories;
721	 * Tcl_FSSplitPath preserves the "~" while this code computes the
722	 * actual full path name, if we had just a single component.
723	 */
724
725	splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements);
726	Tcl_IncrRefCount(splitPtr);
727	if (splitElements == 1  &&  TclGetString(pathPtr)[0] == '~') {
728	    Tcl_Obj *norm;
729
730	    TclDecrRefCount(splitPtr);
731	    norm = Tcl_FSGetNormalizedPath(interp, pathPtr);
732	    if (norm == NULL) {
733		return NULL;
734	    }
735	    splitPtr = Tcl_FSSplitPath(norm, &splitElements);
736	    Tcl_IncrRefCount(splitPtr);
737	}
738	if (portion == TCL_PATH_TAIL) {
739	    /*
740	     * Return the last component, unless it is the only component, and
741	     * it is the root of an absolute path.
742	     */
743
744	    if ((splitElements > 0) && ((splitElements > 1) ||
745		    (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) {
746		Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr);
747	    } else {
748		resultPtr = Tcl_NewObj();
749	    }
750	} else {
751	    /*
752	     * Return all but the last component. If there is only one
753	     * component, return it if the path was non-relative, otherwise
754	     * return the current directory.
755	     */
756
757	    if (splitElements > 1) {
758		resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
759	    } else if (splitElements == 0 ||
760		    (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
761		TclNewLiteralStringObj(resultPtr, ".");
762	    } else {
763		Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr);
764	    }
765	}
766	Tcl_IncrRefCount(resultPtr);
767	TclDecrRefCount(splitPtr);
768	return resultPtr;
769    }
770}
771
772/*
773 * Simple helper function
774 */
775
776static Tcl_Obj *
777GetExtension(
778    Tcl_Obj *pathPtr)
779{
780    const char *tail, *extension;
781    Tcl_Obj *ret;
782
783    tail = TclGetString(pathPtr);
784    extension = TclGetExtension(tail);
785    if (extension == NULL) {
786	ret = Tcl_NewObj();
787    } else {
788	ret = Tcl_NewStringObj(extension, -1);
789    }
790    Tcl_IncrRefCount(ret);
791    return ret;
792}
793
794/*
795 *---------------------------------------------------------------------------
796 *
797 * Tcl_FSJoinPath --
798 *
799 *	This function takes the given Tcl_Obj, which should be a valid list,
800 *	and returns the path object given by considering the first 'elements'
801 *	elements as valid path segments (each path segment may be a complete
802 *	path, a partial path or just a single possible directory or file
803 *	name). If any path segment is actually an absolute path, then all
804 *	prior path segments are discarded.
805 *
806 *	If elements < 0, we use the entire list that was given.
807 *
808 *	It is possible that the returned object is actually an element of the
809 *	given list, so the caller should be careful to store a refCount to it
810 *	before freeing the list.
811 *
812 * Results:
813 *	Returns object with refCount of zero, (or if non-zero, it has
814 *	references elsewhere in Tcl). Either way, the caller must increment
815 *	its refCount before use. Note that in the case where the caller has
816 *	asked to join zero elements of the list, the return value will be an
817 *	empty-string Tcl_Obj.
818 *
819 *	If the given listObj was invalid, then the calling routine has a bug,
820 *	and this function will just return NULL.
821 *
822 * Side effects:
823 *	None.
824 *
825 *---------------------------------------------------------------------------
826 */
827
828Tcl_Obj *
829Tcl_FSJoinPath(
830    Tcl_Obj *listObj,		/* Path elements to join, may have a zero
831				 * reference count. */
832    int elements)		/* Number of elements to use (-1 = all) */
833{
834    Tcl_Obj *res;
835    int i;
836    Tcl_Filesystem *fsPtr = NULL;
837
838    if (elements < 0) {
839	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
840	    return NULL;
841	}
842    } else {
843	/*
844	 * Just make sure it is a valid list.
845	 */
846
847	int listTest;
848
849	if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
850	    return NULL;
851	}
852
853	/*
854	 * Correct this if it is too large, otherwise we will waste our time
855	 * joining null elements to the path.
856	 */
857
858	if (elements > listTest) {
859	    elements = listTest;
860	}
861    }
862
863    res = NULL;
864
865    for (i = 0; i < elements; i++) {
866	Tcl_Obj *elt, *driveName = NULL;
867	int driveNameLength, strEltLen, length;
868	Tcl_PathType type;
869	char *strElt, *ptr;
870
871	Tcl_ListObjIndex(NULL, listObj, i, &elt);
872
873	/*
874	 * This is a special case where we can be much more efficient, where
875	 * we are joining a single relative path onto an object that is
876	 * already of path type. The 'TclNewFSPathObj' call below creates an
877	 * object which can be normalized more efficiently. Currently we only
878	 * use the special case when we have exactly two elements, but we
879	 * could expand that in the future.
880	 */
881
882	if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
883		&& !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
884	    Tcl_Obj *tail;
885
886	    Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
887	    type = TclGetPathType(tail, NULL, NULL, NULL);
888	    if (type == TCL_PATH_RELATIVE) {
889		const char *str;
890		int len;
891
892		str = Tcl_GetStringFromObj(tail, &len);
893		if (len == 0) {
894		    /*
895		     * This happens if we try to handle the root volume '/'.
896		     * There's no need to return a special path object, when
897		     * the base itself is just fine!
898		     */
899
900		    if (res != NULL) {
901			TclDecrRefCount(res);
902		    }
903		    return elt;
904		}
905
906		/*
907		 * If it doesn't begin with '.' and is a unix path or it a
908		 * windows path without backslashes, then we can be very
909		 * efficient here. (In fact even a windows path with
910		 * backslashes can be joined efficiently, but the path object
911		 * would not have forward slashes only, and this would
912		 * therefore contradict our 'file join' documentation).
913		 */
914
915		if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS)
916			|| (strchr(str, '\\') == NULL))) {
917		    /*
918		     * Finally, on Windows, 'file join' is defined to convert
919		     * all backslashes to forward slashes, so the base part
920		     * cannot have backslashes either.
921		     */
922
923		    if ((tclPlatform != TCL_PLATFORM_WINDOWS)
924			    || (strchr(Tcl_GetString(elt), '\\') == NULL)) {
925			if (res != NULL) {
926			    TclDecrRefCount(res);
927			}
928			return TclNewFSPathObj(elt, str, len);
929		    }
930		}
931
932		/*
933		 * Otherwise we don't have an easy join, and we must let the
934		 * more general code below handle things.
935		 */
936	    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
937		if (res != NULL) {
938		    TclDecrRefCount(res);
939		}
940		return tail;
941	    } else {
942		const char *str = TclGetString(tail);
943
944		if (tclPlatform == TCL_PLATFORM_WINDOWS) {
945		    if (strchr(str, '\\') == NULL) {
946			if (res != NULL) {
947			    TclDecrRefCount(res);
948			}
949			return tail;
950		    }
951		}
952	    }
953	}
954	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
955	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
956	if (type != TCL_PATH_RELATIVE) {
957	    /*
958	     * Zero out the current result.
959	     */
960
961	    if (res != NULL) {
962		TclDecrRefCount(res);
963	    }
964
965	    if (driveName != NULL) {
966		/*
967		 * We've been given a separate drive-name object, because the
968		 * prefix in 'elt' is not in a suitable format for us (e.g. it
969		 * may contain irrelevant multiple separators, like
970		 * C://///foo).
971		 */
972
973		res = Tcl_DuplicateObj(driveName);
974		TclDecrRefCount(driveName);
975
976		/*
977		 * Do not set driveName to NULL, because we will check its
978		 * value below (but we won't access the contents, since those
979		 * have been cleaned-up).
980		 */
981	    } else {
982		res = Tcl_NewStringObj(strElt, driveNameLength);
983	    }
984	    strElt += driveNameLength;
985	} else if (driveName != NULL) {
986	    Tcl_DecrRefCount(driveName);
987	}
988
989	/*
990	 * Optimisation block: if this is the last element to be examined, and
991	 * it is absolute or the only element, and the drive-prefix was ok (if
992	 * there is one), it might be that the path is already in a suitable
993	 * form to be returned. Then we can short-cut the rest of this
994	 * function.
995	 */
996
997	if ((driveName == NULL) && (i == (elements - 1))
998		&& (type != TCL_PATH_RELATIVE || res == NULL)) {
999	    /*
1000	     * It's the last path segment. Perform a quick check if the path
1001	     * is already in a suitable form.
1002	     */
1003
1004	    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
1005		if (strchr(strElt, '\\') != NULL) {
1006		    goto noQuickReturn;
1007		}
1008	    }
1009	    ptr = strElt;
1010	    while (*ptr != '\0') {
1011		if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) {
1012		    /*
1013		     * We have a repeated file separator, which means the path
1014		     * is not in normalized form
1015		     */
1016
1017		    goto noQuickReturn;
1018		}
1019		ptr++;
1020	    }
1021	    if (res != NULL) {
1022		TclDecrRefCount(res);
1023	    }
1024
1025	    /*
1026	     * This element is just what we want to return already - no
1027	     * further manipulation is requred.
1028	     */
1029
1030	    return elt;
1031	}
1032
1033	/*
1034	 * The path element was not of a suitable form to be returned as is.
1035	 * We need to perform a more complex operation here.
1036	 */
1037
1038    noQuickReturn:
1039	if (res == NULL) {
1040	    res = Tcl_NewObj();
1041	    ptr = Tcl_GetStringFromObj(res, &length);
1042	} else {
1043	    ptr = Tcl_GetStringFromObj(res, &length);
1044	}
1045
1046	/*
1047	 * Strip off any './' before a tilde, unless this is the beginning of
1048	 * the path.
1049	 */
1050
1051	if (length > 0 && strEltLen > 0 && (strElt[0] == '.') &&
1052		(strElt[1] == '/') && (strElt[2] == '~')) {
1053	    strElt += 2;
1054	}
1055
1056	/*
1057	 * A NULL value for fsPtr at this stage basically means we're trying
1058	 * to join a relative path onto something which is also relative (or
1059	 * empty). There's nothing particularly wrong with that.
1060	 */
1061
1062	if (*strElt == '\0') {
1063	    continue;
1064	}
1065
1066	if (fsPtr == &tclNativeFilesystem || fsPtr == NULL) {
1067	    TclpNativeJoinPath(res, strElt);
1068	} else {
1069	    char separator = '/';
1070	    int needsSep = 0;
1071
1072	    if (fsPtr->filesystemSeparatorProc != NULL) {
1073		Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res);
1074
1075		if (sep != NULL) {
1076		    separator = TclGetString(sep)[0];
1077		}
1078	    }
1079
1080	    if (length > 0 && ptr[length -1] != '/') {
1081		Tcl_AppendToObj(res, &separator, 1);
1082		length++;
1083	    }
1084	    Tcl_SetObjLength(res, length + (int) strlen(strElt));
1085
1086	    ptr = TclGetString(res) + length;
1087	    for (; *strElt != '\0'; strElt++) {
1088		if (*strElt == separator) {
1089		    while (strElt[1] == separator) {
1090			strElt++;
1091		    }
1092		    if (strElt[1] != '\0') {
1093			if (needsSep) {
1094			    *ptr++ = separator;
1095			}
1096		    }
1097		} else {
1098		    *ptr++ = *strElt;
1099		    needsSep = 1;
1100		}
1101	    }
1102	    length = ptr - TclGetString(res);
1103	    Tcl_SetObjLength(res, length);
1104	}
1105    }
1106    if (res == NULL) {
1107	res = Tcl_NewObj();
1108    }
1109    return res;
1110}
1111
1112/*
1113 *---------------------------------------------------------------------------
1114 *
1115 * Tcl_FSConvertToPathType --
1116 *
1117 *	This function tries to convert the given Tcl_Obj to a valid Tcl path
1118 *	type, taking account of the fact that the cwd may have changed even if
1119 *	this object is already supposedly of the correct type.
1120 *
1121 *	The filename may begin with "~" (to indicate current user's home
1122 *	directory) or "~<user>" (to indicate any user's home directory).
1123 *
1124 * Results:
1125 *	Standard Tcl error code.
1126 *
1127 * Side effects:
1128 *	The old representation may be freed, and new memory allocated.
1129 *
1130 *---------------------------------------------------------------------------
1131 */
1132
1133int
1134Tcl_FSConvertToPathType(
1135    Tcl_Interp *interp,		/* Interpreter in which to store error message
1136				 * (if necessary). */
1137    Tcl_Obj *pathPtr)		/* Object to convert to a valid, current path
1138				 * type. */
1139{
1140    /*
1141     * While it is bad practice to examine an object's type directly, this is
1142     * actually the best thing to do here. The reason is that if we are
1143     * converting this object to FsPath type for the first time, we don't need
1144     * to worry whether the 'cwd' has changed. On the other hand, if this
1145     * object is already of FsPath type, and is a relative path, we do have to
1146     * worry about the cwd. If the cwd has changed, we must recompute the
1147     * path.
1148     */
1149
1150    if (pathPtr->typePtr == &tclFsPathType) {
1151	if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
1152	    return TCL_OK;
1153	}
1154
1155	if (pathPtr->bytes == NULL) {
1156	    UpdateStringOfFsPath(pathPtr);
1157	}
1158	FreeFsPathInternalRep(pathPtr);
1159	pathPtr->typePtr = NULL;
1160    }
1161
1162    return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
1163
1164    /*
1165     * We used to have more complex code here:
1166     *
1167     * FsPath *fsPathPtr = PATHOBJ(pathPtr);
1168     * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
1169     *     return TCL_OK;
1170     * } else {
1171     *     if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
1172     *         return TCL_OK;
1173     *     } else {
1174     *         if (pathPtr->bytes == NULL) {
1175     *             UpdateStringOfFsPath(pathPtr);
1176     *         }
1177     *         FreeFsPathInternalRep(pathPtr);
1178     *         pathPtr->typePtr = NULL;
1179     *         return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
1180     *     }
1181     * }
1182     *
1183     * But we no longer believe this is necessary.
1184     */
1185}
1186
1187/*
1188 * Helper function for normalization.
1189 */
1190
1191static int
1192IsSeparatorOrNull(
1193    int ch)
1194{
1195    if (ch == 0) {
1196	return 1;
1197    }
1198    switch (tclPlatform) {
1199    case TCL_PLATFORM_UNIX:
1200	return (ch == '/' ? 1 : 0);
1201    case TCL_PLATFORM_WINDOWS:
1202	return ((ch == '/' || ch == '\\') ? 1 : 0);
1203    }
1204    return 0;
1205}
1206
1207/*
1208 * Helper function for SetFsPathFromAny. Returns position of first directory
1209 * delimiter in the path. If no separator is found, then returns the position
1210 * of the end of the string.
1211 */
1212
1213static int
1214FindSplitPos(
1215    const char *path,
1216    int separator)
1217{
1218    int count = 0;
1219    switch (tclPlatform) {
1220    case TCL_PLATFORM_UNIX:
1221	while (path[count] != 0) {
1222	    if (path[count] == separator) {
1223		return count;
1224	    }
1225	    count++;
1226	}
1227	break;
1228
1229    case TCL_PLATFORM_WINDOWS:
1230	while (path[count] != 0) {
1231	    if (path[count] == separator || path[count] == '\\') {
1232		return count;
1233	    }
1234	    count++;
1235	}
1236	break;
1237    }
1238    return count;
1239}
1240
1241/*
1242 *---------------------------------------------------------------------------
1243 *
1244 * TclNewFSPathObj --
1245 *
1246 *	Creates a path object whose string representation is '[file join
1247 *	dirPtr addStrRep]', but does so in a way that allows for more
1248 *	efficient creation and caching of normalized paths, and more efficient
1249 *	'file dirname', 'file tail', etc.
1250 *
1251 * Assumptions:
1252 *	'dirPtr' must be an absolute path. 'len' may not be zero.
1253 *
1254 * Results:
1255 *	The new Tcl object, with refCount zero.
1256 *
1257 * Side effects:
1258 *	Memory is allocated. 'dirPtr' gets an additional refCount.
1259 *
1260 *---------------------------------------------------------------------------
1261 */
1262
1263Tcl_Obj *
1264TclNewFSPathObj(
1265    Tcl_Obj *dirPtr,
1266    const char *addStrRep,
1267    int len)
1268{
1269    FsPath *fsPathPtr;
1270    Tcl_Obj *pathPtr;
1271    ThreadSpecificData *tsdPtr;
1272    const char *p;
1273    int state = 0, count = 0;
1274
1275    /* [Bug 2806250] - this is only a partial solution of the problem.
1276     * The PATHFLAGS != 0 representation assumes in many places that
1277     * the "tail" part stored in the normPathPtr field is itself a
1278     * relative path.  Strings that begin with "~" are not relative paths,
1279     * so we must prevent their storage in the normPathPtr field.
1280     *
1281     * More generally we ought to be testing "addStrRep" for any value
1282     * that is not a relative path, but in an unconstrained VFS world
1283     * that could be just about anything, and testing could be expensive.
1284     * Since this routine plays a big role in [glob], anything that slows
1285     * it down would be unwelcome.  For now, continue the risk of further
1286     * bugs when some Tcl_Filesystem uses otherwise relative path strings
1287     * as absolute path strings.  Sensible Tcl_Filesystems will avoid
1288     * that by mounting on path prefixes like foo:// which cannot be the
1289     * name of a file or directory read from a native [glob] operation.
1290     */
1291    if (addStrRep[0] == '~') {
1292	Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len);
1293
1294	pathPtr = AppendPath(dirPtr, tail);
1295	Tcl_DecrRefCount(tail);
1296	return pathPtr;
1297    }
1298
1299    tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
1300
1301    pathPtr = Tcl_NewObj();
1302    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
1303
1304    /*
1305     * Set up the path.
1306     */
1307
1308    fsPathPtr->translatedPathPtr = NULL;
1309    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
1310    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
1311    fsPathPtr->cwdPtr = dirPtr;
1312    Tcl_IncrRefCount(dirPtr);
1313    fsPathPtr->nativePathPtr = NULL;
1314    fsPathPtr->fsRecPtr = NULL;
1315    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
1316
1317    SETPATHOBJ(pathPtr, fsPathPtr);
1318    PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
1319    pathPtr->typePtr = &tclFsPathType;
1320    pathPtr->bytes = NULL;
1321    pathPtr->length = 0;
1322
1323    /*
1324     * Look for path components made up of only "."
1325     * This is overly conservative analysis to keep simple.  It may
1326     * mark some things as needing more aggressive normalization
1327     * that don't actually need it.  No harm done.
1328     */
1329    for (p = addStrRep; len > 0; p++, len--) {
1330       switch (state) {
1331       case 0: /* So far only "." since last dirsep or start */
1332           switch (*p) {
1333           case '.':
1334               count++;
1335               break;
1336           case '/':
1337           case '\\':
1338           case ':':
1339               if (count) {
1340                   PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
1341                   len = 0;
1342               }
1343               break;
1344           default:
1345               count = 0;
1346               state = 1;
1347           }
1348       case 1: /* Scanning for next dirsep */
1349           switch (*p) {
1350           case '/':
1351           case '\\':
1352           case ':':
1353               state = 0;
1354               break;
1355           }
1356       }
1357    }
1358    if (len == 0 && count) {
1359       PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
1360    }
1361
1362    return pathPtr;
1363}
1364
1365static Tcl_Obj *
1366AppendPath(
1367    Tcl_Obj *head,
1368    Tcl_Obj *tail)
1369{
1370    int numBytes;
1371    const char *bytes;
1372    Tcl_Obj *copy = Tcl_DuplicateObj(head);
1373
1374    bytes = Tcl_GetStringFromObj(copy, &numBytes);
1375
1376    /*
1377     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
1378     * Windows special case? Perhaps we should just check if cwd is a root
1379     * volume. We should never get numBytes == 0 in this code path.
1380     */
1381
1382    switch (tclPlatform) {
1383    case TCL_PLATFORM_UNIX:
1384	if (bytes[numBytes-1] != '/') {
1385	    Tcl_AppendToObj(copy, "/", 1);
1386	}
1387	break;
1388
1389    case TCL_PLATFORM_WINDOWS:
1390	/*
1391	 * We need the extra 'numBytes != 2', and ':' checks because a volume
1392	 * relative path doesn't get a '/'. For example 'glob C:*cat*.exe'
1393	 * will return 'C:cat32.exe'
1394	 */
1395
1396	if (bytes[numBytes-1] != '/' && bytes[numBytes-1] != '\\') {
1397	    if (numBytes!= 2 || bytes[1] != ':') {
1398		Tcl_AppendToObj(copy, "/", 1);
1399	    }
1400	}
1401	break;
1402    }
1403
1404    Tcl_AppendObjToObj(copy, tail);
1405    return copy;
1406}
1407
1408/*
1409 *---------------------------------------------------------------------------
1410 *
1411 * TclFSMakePathRelative --
1412 *
1413 *	Only for internal use.
1414 *
1415 *	Takes a path and a directory, where we _assume_ both path and
1416 *	directory are absolute, normalized and that the path lies inside the
1417 *	directory. Returns a Tcl_Obj representing filename of the path
1418 *	relative to the directory.
1419 *
1420 * Results:
1421 *	NULL on error, otherwise a valid object, typically with refCount of
1422 *	zero, which it is assumed the caller will increment.
1423 *
1424 * Side effects:
1425 *	The old representation may be freed, and new memory allocated.
1426 *
1427 *---------------------------------------------------------------------------
1428 */
1429
1430Tcl_Obj *
1431TclFSMakePathRelative(
1432    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
1433    Tcl_Obj *pathPtr,		/* The path we have. */
1434    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
1435{
1436    int cwdLen, len;
1437    const char *tempStr;
1438    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
1439
1440    if (pathPtr->typePtr == &tclFsPathType) {
1441	FsPath *fsPathPtr = PATHOBJ(pathPtr);
1442
1443	if (PATHFLAGS(pathPtr) != 0
1444		&& fsPathPtr->cwdPtr == cwdPtr) {
1445	    pathPtr = fsPathPtr->normPathPtr;
1446
1447	    /* TODO: Determine how much, if any, of this forcing
1448	     * the relative path tail into the "path" Tcl_ObjType
1449	     * with a recorded cwdPtr context has any actual value.
1450	     *
1451	     * Nothing is getting cached.  Not normPathPtr, not nativePathPtr,
1452	     * nor fsRecPtr, so storing the cwdPtr context against which such
1453	     * cached values might later be validated appears to be of no
1454	     * value.  Take that away, and all this code is just a mildly
1455	     * optimized equivalent of a call to SetFsPathFromAny().  That
1456	     * optimization may have some value, *if* these value in fact
1457	     * get used as "path" values before used as something else.
1458	     * If not, though, whatever cost we pay below to convert to
1459	     * one of the "path" intreps is just a waste, it seems.  The
1460	     * usual convention in the core is to delay ObjType conversion
1461	     * until it is needed and demanded, and I don't see why this
1462	     * section of code should be an exception to that.  Leaving it
1463	     * in place for the rest of the 8.5.* releases just for sake
1464	     * of stability.
1465	     */
1466
1467	    /*
1468	     * Free old representation.
1469	     */
1470
1471	    if (pathPtr->typePtr != NULL) {
1472		if (pathPtr->bytes == NULL) {
1473		    if (pathPtr->typePtr->updateStringProc == NULL) {
1474			if (interp != NULL) {
1475			    Tcl_ResetResult(interp);
1476			    Tcl_AppendResult(interp, "can't find object"
1477				    "string representation", NULL);
1478			}
1479			return NULL;
1480		    }
1481		    pathPtr->typePtr->updateStringProc(pathPtr);
1482		}
1483		TclFreeIntRep(pathPtr);
1484	    }
1485
1486	    /*
1487	     * Now pathPtr is a string object.
1488	     */
1489
1490	    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
1491
1492	    /*
1493	     * Circular reference, by design.
1494	     */
1495
1496	    fsPathPtr->translatedPathPtr = pathPtr;
1497	    fsPathPtr->normPathPtr = NULL;
1498	    fsPathPtr->cwdPtr = cwdPtr;
1499	    Tcl_IncrRefCount(cwdPtr);
1500	    fsPathPtr->nativePathPtr = NULL;
1501	    fsPathPtr->fsRecPtr = NULL;
1502	    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
1503
1504	    SETPATHOBJ(pathPtr, fsPathPtr);
1505	    PATHFLAGS(pathPtr) = 0;
1506	    pathPtr->typePtr = &tclFsPathType;
1507
1508	    return pathPtr;
1509	}
1510    }
1511
1512    /*
1513     * We know the cwd is a normalised object which does not end in a
1514     * directory delimiter, unless the cwd is the name of a volume, in which
1515     * case it will end in a delimiter! We handle this situation here. A
1516     * better test than the '!= sep' might be to simply check if 'cwd' is a
1517     * root volume.
1518     *
1519     * Note that if we get this wrong, we will strip off either too much or
1520     * too little below, leading to wrong answers returned by glob.
1521     */
1522
1523    tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
1524
1525    /*
1526     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
1527     * Windows special case? Perhaps we should just check if cwd is a root
1528     * volume.
1529     */
1530
1531    switch (tclPlatform) {
1532    case TCL_PLATFORM_UNIX:
1533	if (tempStr[cwdLen-1] != '/') {
1534	    cwdLen++;
1535	}
1536	break;
1537    case TCL_PLATFORM_WINDOWS:
1538	if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') {
1539	    cwdLen++;
1540	}
1541	break;
1542    }
1543    tempStr = Tcl_GetStringFromObj(pathPtr, &len);
1544
1545    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
1546}
1547
1548/*
1549 *---------------------------------------------------------------------------
1550 *
1551 * TclFSMakePathFromNormalized --
1552 *
1553 *	Like SetFsPathFromAny, but assumes the given object is an absolute
1554 *	normalized path. Only for internal use.
1555 *
1556 * Results:
1557 *	Standard Tcl error code.
1558 *
1559 * Side effects:
1560 *	The old representation may be freed, and new memory allocated.
1561 *
1562 *---------------------------------------------------------------------------
1563 */
1564
1565int
1566TclFSMakePathFromNormalized(
1567    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
1568    Tcl_Obj *pathPtr,		/* The object to convert. */
1569    ClientData nativeRep)	/* The native rep for the object, if known
1570				 * else NULL. */
1571{
1572    FsPath *fsPathPtr;
1573    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
1574
1575    if (pathPtr->typePtr == &tclFsPathType) {
1576	return TCL_OK;
1577    }
1578
1579    /*
1580     * Free old representation
1581     */
1582
1583    if (pathPtr->typePtr != NULL) {
1584	if (pathPtr->bytes == NULL) {
1585	    if (pathPtr->typePtr->updateStringProc == NULL) {
1586		if (interp != NULL) {
1587		    Tcl_ResetResult(interp);
1588		    Tcl_AppendResult(interp, "can't find object"
1589			    "string representation", NULL);
1590		}
1591		return TCL_ERROR;
1592	    }
1593	    pathPtr->typePtr->updateStringProc(pathPtr);
1594	}
1595	TclFreeIntRep(pathPtr);
1596    }
1597
1598    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
1599
1600    /*
1601     * It's a pure normalized absolute path.
1602     */
1603
1604    fsPathPtr->translatedPathPtr = NULL;
1605
1606    /*
1607     * Circular reference by design.
1608     */
1609
1610    fsPathPtr->normPathPtr = pathPtr;
1611    fsPathPtr->cwdPtr = NULL;
1612    fsPathPtr->nativePathPtr = nativeRep;
1613    fsPathPtr->fsRecPtr = NULL;
1614    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
1615
1616    SETPATHOBJ(pathPtr, fsPathPtr);
1617    PATHFLAGS(pathPtr) = 0;
1618    pathPtr->typePtr = &tclFsPathType;
1619
1620    return TCL_OK;
1621}
1622
1623/*
1624 *---------------------------------------------------------------------------
1625 *
1626 * Tcl_FSNewNativePath --
1627 *
1628 *	This function performs the something like the reverse of the usual
1629 *	obj->path->nativerep conversions. If some code retrieves a path in
1630 *	native form (from, e.g. readlink or a native dialog), and that path is
1631 *	to be used at the Tcl level, then calling this function is an
1632 *	efficient way of creating the appropriate path object type.
1633 *
1634 *	Any memory which is allocated for 'clientData' should be retained
1635 *	until clientData is passed to the filesystem's freeInternalRepProc
1636 *	when it can be freed. The built in platform-specific filesystems use
1637 *	'ckalloc' to allocate clientData, and ckfree to free it.
1638 *
1639 * Results:
1640 *	NULL or a valid path object pointer, with refCount zero.
1641 *
1642 * Side effects:
1643 *	New memory may be allocated.
1644 *
1645 *---------------------------------------------------------------------------
1646 */
1647
1648Tcl_Obj *
1649Tcl_FSNewNativePath(
1650    Tcl_Filesystem *fromFilesystem,
1651    ClientData clientData)
1652{
1653    Tcl_Obj *pathPtr;
1654    FsPath *fsPathPtr;
1655
1656    FilesystemRecord *fsFromPtr;
1657    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
1658
1659    pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData,
1660	    &fsFromPtr);
1661    if (pathPtr == NULL) {
1662	return NULL;
1663    }
1664
1665    /*
1666     * Free old representation; shouldn't normally be any, but best to be
1667     * safe.
1668     */
1669
1670    if (pathPtr->typePtr != NULL) {
1671	if (pathPtr->bytes == NULL) {
1672	    if (pathPtr->typePtr->updateStringProc == NULL) {
1673		return NULL;
1674	    }
1675	    pathPtr->typePtr->updateStringProc(pathPtr);
1676	}
1677	TclFreeIntRep(pathPtr);
1678    }
1679
1680    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
1681
1682    fsPathPtr->translatedPathPtr = NULL;
1683
1684    /*
1685     * Circular reference, by design.
1686     */
1687
1688    fsPathPtr->normPathPtr = pathPtr;
1689    fsPathPtr->cwdPtr = NULL;
1690    fsPathPtr->nativePathPtr = clientData;
1691    fsPathPtr->fsRecPtr = fsFromPtr;
1692    fsPathPtr->fsRecPtr->fileRefCount++;
1693    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
1694
1695    SETPATHOBJ(pathPtr, fsPathPtr);
1696    PATHFLAGS(pathPtr) = 0;
1697    pathPtr->typePtr = &tclFsPathType;
1698
1699    return pathPtr;
1700}
1701
1702/*
1703 *---------------------------------------------------------------------------
1704 *
1705 * Tcl_FSGetTranslatedPath --
1706 *
1707 *	This function attempts to extract the translated path from the given
1708 *	Tcl_Obj. If the translation succeeds (i.e. the object is a valid
1709 *	path), then it is returned. Otherwise NULL will be returned, and an
1710 *	error message may be left in the interpreter (if it is non-NULL)
1711 *
1712 * Results:
1713 *	NULL or a valid Tcl_Obj pointer.
1714 *
1715 * Side effects:
1716 *	Only those of 'Tcl_FSConvertToPathType'
1717 *
1718 *---------------------------------------------------------------------------
1719 */
1720
1721Tcl_Obj *
1722Tcl_FSGetTranslatedPath(
1723    Tcl_Interp *interp,
1724    Tcl_Obj *pathPtr)
1725{
1726    Tcl_Obj *retObj = NULL;
1727    FsPath *srcFsPathPtr;
1728
1729    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
1730	return NULL;
1731    }
1732    srcFsPathPtr = PATHOBJ(pathPtr);
1733    if (srcFsPathPtr->translatedPathPtr == NULL) {
1734	if (PATHFLAGS(pathPtr) != 0) {
1735	    /*
1736	     * We lack a translated path result, but we have a directory
1737	     * (cwdPtr) and a tail (normPathPtr), and if we join the
1738	     * translated version of cwdPtr to normPathPtr, we'll get the
1739	     * translated result we need, and can store it for future use.
1740	     */
1741
1742	    Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
1743		    srcFsPathPtr->cwdPtr);
1744	    if (translatedCwdPtr == NULL) {
1745		return NULL;
1746	    }
1747
1748	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
1749		    &(srcFsPathPtr->normPathPtr));
1750	    srcFsPathPtr->translatedPathPtr = retObj;
1751	    Tcl_IncrRefCount(retObj);
1752	    Tcl_DecrRefCount(translatedCwdPtr);
1753	} else {
1754	    /*
1755	     * It is a pure absolute, normalized path object. This is
1756	     * something like being a 'pure list'. The object's string,
1757	     * translatedPath and normalizedPath are all identical.
1758	     */
1759
1760	    retObj = srcFsPathPtr->normPathPtr;
1761	}
1762    } else {
1763	/*
1764	 * It is an ordinary path object.
1765	 */
1766
1767	retObj = srcFsPathPtr->translatedPathPtr;
1768    }
1769
1770    if (retObj != NULL) {
1771	Tcl_IncrRefCount(retObj);
1772    }
1773    return retObj;
1774}
1775
1776/*
1777 *---------------------------------------------------------------------------
1778 *
1779 * Tcl_FSGetTranslatedStringPath --
1780 *
1781 *	This function attempts to extract the translated path from the given
1782 *	Tcl_Obj. If the translation succeeds (i.e. the object is a valid
1783 *	path), then the path is returned. Otherwise NULL will be returned, and
1784 *	an error message may be left in the interpreter (if it is non-NULL)
1785 *
1786 * Results:
1787 *	NULL or a valid string.
1788 *
1789 * Side effects:
1790 *	Only those of 'Tcl_FSConvertToPathType'
1791 *
1792 *---------------------------------------------------------------------------
1793 */
1794
1795const char *
1796Tcl_FSGetTranslatedStringPath(
1797    Tcl_Interp *interp,
1798    Tcl_Obj *pathPtr)
1799{
1800    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
1801
1802    if (transPtr != NULL) {
1803	int len;
1804	const char *orig = Tcl_GetStringFromObj(transPtr, &len);
1805	char *result = (char *) ckalloc((unsigned) len+1);
1806
1807	memcpy(result, orig, (size_t) len+1);
1808	TclDecrRefCount(transPtr);
1809	return result;
1810    }
1811
1812    return NULL;
1813}
1814
1815/*
1816 *---------------------------------------------------------------------------
1817 *
1818 * Tcl_FSGetNormalizedPath --
1819 *
1820 *	This important function attempts to extract from the given Tcl_Obj a
1821 *	unique normalised path representation, whose string value can be used
1822 *	as a unique identifier for the file.
1823 *
1824 * Results:
1825 *	NULL or a valid path object pointer.
1826 *
1827 * Side effects:
1828 *	New memory may be allocated. The Tcl 'errno' may be modified in the
1829 *	process of trying to examine various path possibilities.
1830 *
1831 *---------------------------------------------------------------------------
1832 */
1833
1834Tcl_Obj *
1835Tcl_FSGetNormalizedPath(
1836    Tcl_Interp *interp,
1837    Tcl_Obj *pathPtr)
1838{
1839    FsPath *fsPathPtr;
1840
1841    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
1842	return NULL;
1843    }
1844    fsPathPtr = PATHOBJ(pathPtr);
1845
1846    if (PATHFLAGS(pathPtr) != 0) {
1847	/*
1848	 * This is a special path object which is the result of something like
1849	 * 'file join'
1850	 */
1851
1852	Tcl_Obj *dir, *copy;
1853	int cwdLen, pathType;
1854	ClientData clientData = NULL;
1855
1856	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
1857	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
1858	if (dir == NULL) {
1859	    return NULL;
1860	}
1861	/* TODO: Figure out why this is needed. */
1862	if (pathPtr->bytes == NULL) {
1863	    UpdateStringOfFsPath(pathPtr);
1864	}
1865
1866	copy = AppendPath(dir, fsPathPtr->normPathPtr);
1867	Tcl_IncrRefCount(dir);
1868	Tcl_IncrRefCount(copy);
1869
1870	/*
1871	 * We now own a reference on both 'dir' and 'copy'
1872	 */
1873
1874	(void) Tcl_GetStringFromObj(dir, &cwdLen);
1875	cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
1876
1877	/* Normalize the combined string. */
1878
1879	if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
1880	    /*
1881	     * If the "tail" part has components (like /../) that cause
1882	     * the combined path to need more complete normalizing,
1883	     * call on the more powerful routine to accomplish that so
1884	     * we avoid [Bug 2385549] ...
1885	     */
1886
1887	    Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy, NULL);
1888	    Tcl_DecrRefCount(copy);
1889	    copy = newCopy;
1890	} else {
1891	    /*
1892	     * ... but in most cases where we join a trouble free tail
1893	     * to a normalized head, we can more efficiently normalize the
1894	     * combined path by passing over only the unnormalized tail
1895	     * portion.  When this is sufficient, prior developers claim
1896	     * this should be much faster.  We use 'cwdLen-1' so that we are
1897	     * already pointing at the dir-separator that we know about.
1898	     * The normalization code will actually start off directly
1899	     * after that separator.
1900	     */
1901
1902	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1,
1903		    (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
1904	}
1905
1906	/* Now we need to construct the new path object. */
1907
1908	if (pathType == TCL_PATH_RELATIVE) {
1909	    Tcl_Obj *origDir = fsPathPtr->cwdPtr;
1910
1911	    /*
1912	     * NOTE: here we are (dangerously?) assuming that origDir points
1913	     * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType .  The
1914	     *     pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
1915	     * above that set the pathType value should have established
1916	     * that, but it's far less clear on what basis we know there's
1917	     * been no shimmering since then.
1918	     */
1919
1920	    FsPath *origDirFsPathPtr = PATHOBJ(origDir);
1921
1922	    fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
1923	    Tcl_IncrRefCount(fsPathPtr->cwdPtr);
1924
1925	    TclDecrRefCount(fsPathPtr->normPathPtr);
1926	    fsPathPtr->normPathPtr = copy;
1927
1928	    /*
1929	     * That's our reference to copy used.
1930	     */
1931
1932	    TclDecrRefCount(dir);
1933	    TclDecrRefCount(origDir);
1934	} else {
1935	    TclDecrRefCount(fsPathPtr->cwdPtr);
1936	    fsPathPtr->cwdPtr = NULL;
1937	    TclDecrRefCount(fsPathPtr->normPathPtr);
1938	    fsPathPtr->normPathPtr = copy;
1939
1940	    /*
1941	     * That's our reference to copy used.
1942	     */
1943
1944	    TclDecrRefCount(dir);
1945	}
1946	if (clientData != NULL) {
1947	    /*
1948	     * This may be unnecessary. It appears that the
1949	     * TclFSNormalizeToUniquePath call above should have already
1950	     * set this up.  Not changing out of fear of the unknown.
1951	     */
1952
1953	    fsPathPtr->nativePathPtr = clientData;
1954	}
1955	PATHFLAGS(pathPtr) = 0;
1956    }
1957
1958    /*
1959     * Ensure cwd hasn't changed.
1960     */
1961
1962    if (fsPathPtr->cwdPtr != NULL) {
1963	if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
1964	    if (pathPtr->bytes == NULL) {
1965		UpdateStringOfFsPath(pathPtr);
1966	    }
1967	    FreeFsPathInternalRep(pathPtr);
1968	    pathPtr->typePtr = NULL;
1969	    if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) {
1970		return NULL;
1971	    }
1972	    fsPathPtr = PATHOBJ(pathPtr);
1973	} else if (fsPathPtr->normPathPtr == NULL) {
1974	    int cwdLen;
1975	    Tcl_Obj *copy;
1976	    ClientData clientData = NULL;
1977
1978	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);
1979
1980	    (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
1981	    cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
1982
1983	    /*
1984	     * Normalize the combined string, but only starting after the end
1985	     * of the previously normalized 'dir'. This should be much faster!
1986	     */
1987
1988	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1,
1989		    (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
1990	    fsPathPtr->normPathPtr = copy;
1991	    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
1992	    if (clientData != NULL) {
1993		fsPathPtr->nativePathPtr = clientData;
1994	    }
1995	}
1996    }
1997    if (fsPathPtr->normPathPtr == NULL) {
1998	ClientData clientData = NULL;
1999	Tcl_Obj *useThisCwd = NULL;
2000	int pureNormalized = 1;
2001
2002	/*
2003	 * Since normPathPtr is NULL, but this is a valid path object, we know
2004	 * that the translatedPathPtr cannot be NULL.
2005	 */
2006
2007	Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
2008	const char *path = TclGetString(absolutePath);
2009
2010	Tcl_IncrRefCount(absolutePath);
2011
2012	/*
2013	 * We have to be a little bit careful here to avoid infinite loops
2014	 * we're asking Tcl_FSGetPathType to return the path's type, but that
2015	 * call can actually result in a lot of other filesystem action, which
2016	 * might loop back through here.
2017	 */
2018
2019	if (path[0] == '\0') {
2020	    /*
2021	     * Special handling for the empty string value.  This one is
2022	     * very weird with [file normalize {}] => {}.  (The reasoning
2023	     * supporting this is unknown to DGP, but he fears changing it.)
2024	     * Attempt here to keep the expectations of other parts of
2025	     * Tcl_Filesystem code about state of the FsPath fields satisfied.
2026	     *
2027	     * In particular, capture the cwd value and save so it can be
2028	     * stored in the cwdPtr field below.
2029	     */
2030
2031	    useThisCwd = Tcl_FSGetCwd(interp);
2032	} else {
2033	    /*
2034	     * We don't ask for the type of 'pathPtr' here, because that is
2035	     * not correct for our purposes when we have a path like '~'. Tcl
2036	     * has a bit of a contradiction in that '~' paths are defined as
2037	     * 'absolute', but in reality can be just about anything,
2038	     * depending on how env(HOME) is set.
2039	     */
2040
2041	    Tcl_PathType type = Tcl_FSGetPathType(absolutePath);
2042
2043	    if (type == TCL_PATH_RELATIVE) {
2044		useThisCwd = Tcl_FSGetCwd(interp);
2045
2046		if (useThisCwd == NULL) {
2047		    return NULL;
2048		}
2049
2050		pureNormalized = 0;
2051		Tcl_DecrRefCount(absolutePath);
2052		absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
2053		Tcl_IncrRefCount(absolutePath);
2054
2055		/*
2056		 * We have a refCount on the cwd.
2057		 */
2058#ifdef __WIN32__
2059	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
2060		/*
2061		 * Only Windows has volume-relative paths.
2062		 */
2063
2064		Tcl_DecrRefCount(absolutePath);
2065		absolutePath = TclWinVolumeRelativeNormalize(interp,
2066			path, &useThisCwd);
2067		if (absolutePath == NULL) {
2068		    return NULL;
2069		}
2070		pureNormalized = 0;
2071#endif /* __WIN32__ */
2072	    }
2073	}
2074
2075	/*
2076	 * Already has refCount incremented.
2077	 */
2078
2079	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
2080		absolutePath,
2081		(fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
2082	if (0 && (clientData != NULL)) {
2083	    fsPathPtr->nativePathPtr =
2084		(*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData);
2085	}
2086
2087	/*
2088	 * Check if path is pure normalized (this can only be the case if it
2089	 * is an absolute path).
2090	 */
2091
2092	if (pureNormalized) {
2093	    if (!strcmp(TclGetString(fsPathPtr->normPathPtr),
2094		    TclGetString(pathPtr))) {
2095		/*
2096		 * The path was already normalized. Get rid of the duplicate.
2097		 */
2098
2099		TclDecrRefCount(fsPathPtr->normPathPtr);
2100
2101		/*
2102		 * We do *not* increment the refCount for this circular
2103		 * reference.
2104		 */
2105
2106		fsPathPtr->normPathPtr = pathPtr;
2107	    }
2108	}
2109	if (useThisCwd != NULL) {
2110	    /*
2111	     * We just need to free an object we allocated above for relative
2112	     * paths (this was returned by Tcl_FSJoinToPath above), and then
2113	     * of course store the cwd.
2114	     */
2115
2116	    fsPathPtr->cwdPtr = useThisCwd;
2117	}
2118	TclDecrRefCount(absolutePath);
2119    }
2120
2121    return fsPathPtr->normPathPtr;
2122}
2123
2124/*
2125 *---------------------------------------------------------------------------
2126 *
2127 * Tcl_FSGetInternalRep --
2128 *
2129 *	Extract the internal representation of a given path object, in the
2130 *	given filesystem. If the path object belongs to a different
2131 *	filesystem, we return NULL.
2132 *
2133 *	If the internal representation is currently NULL, we attempt to
2134 *	generate it, by calling the filesystem's
2135 *	'Tcl_FSCreateInternalRepProc'.
2136 *
2137 * Results:
2138 *	NULL or a valid internal representation.
2139 *
2140 * Side effects:
2141 *	An attempt may be made to convert the object.
2142 *
2143 *---------------------------------------------------------------------------
2144 */
2145
2146ClientData
2147Tcl_FSGetInternalRep(
2148    Tcl_Obj *pathPtr,
2149    Tcl_Filesystem *fsPtr)
2150{
2151    FsPath *srcFsPathPtr;
2152
2153    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
2154	return NULL;
2155    }
2156    srcFsPathPtr = PATHOBJ(pathPtr);
2157
2158    /*
2159     * We will only return the native representation for the caller's
2160     * filesystem. Otherwise we will simply return NULL. This means that there
2161     * must be a unique bi-directional mapping between paths and filesystems,
2162     * and that this mapping will not allow 'remapped' files -- files which
2163     * are in one filesystem but mapped into another. Another way of putting
2164     * this is that 'stacked' filesystems are not allowed. We recognise that
2165     * this is a potentially useful feature for the future.
2166     *
2167     * Even something simple like a 'pass through' filesystem which logs all
2168     * activity and passes the calls onto the native system would be nice, but
2169     * not easily achievable with the current implementation.
2170     */
2171
2172    if (srcFsPathPtr->fsRecPtr == NULL) {
2173	/*
2174	 * This only usually happens in wrappers like TclpStat which create a
2175	 * string object and pass it to TclpObjStat. Code which calls the
2176	 * Tcl_FS.. functions should always have a filesystem already set.
2177	 * Whether this code path is legal or not depends on whether we decide
2178	 * to allow external code to call the native filesystem directly. It
2179	 * is at least safer to allow this sub-optimal routing.
2180	 */
2181
2182	Tcl_FSGetFileSystemForPath(pathPtr);
2183
2184	/*
2185	 * If we fail through here, then the path is probably not a valid path
2186	 * in the filesystsem, and is most likely to be a use of the empty
2187	 * path "" via a direct call to one of the objectified interfaces
2188	 * (e.g. from the Tcl testsuite).
2189	 */
2190
2191	srcFsPathPtr = PATHOBJ(pathPtr);
2192	if (srcFsPathPtr->fsRecPtr == NULL) {
2193	    return NULL;
2194	}
2195    }
2196
2197    /*
2198     * There is still one possibility we should consider; if the file belongs
2199     * to a different filesystem, perhaps it is actually linked through to a
2200     * file in our own filesystem which we do care about. The way we can check
2201     * for this is we ask what filesystem this path belongs to.
2202     */
2203
2204    if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
2205	const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr);
2206
2207	if (actualFs == fsPtr) {
2208	    return Tcl_FSGetInternalRep(pathPtr, fsPtr);
2209	}
2210	return NULL;
2211    }
2212
2213    if (srcFsPathPtr->nativePathPtr == NULL) {
2214	Tcl_FSCreateInternalRepProc *proc;
2215	char *nativePathPtr;
2216
2217	proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
2218	if (proc == NULL) {
2219	    return NULL;
2220	}
2221
2222	nativePathPtr = (*proc)(pathPtr);
2223	srcFsPathPtr = PATHOBJ(pathPtr);
2224	srcFsPathPtr->nativePathPtr = nativePathPtr;
2225    }
2226
2227    return srcFsPathPtr->nativePathPtr;
2228}
2229
2230/*
2231 *---------------------------------------------------------------------------
2232 *
2233 * TclFSEnsureEpochOk --
2234 *
2235 *	This will ensure the pathPtr is up to date and can be converted into a
2236 *	"path" type, and that we are able to generate a complete normalized
2237 *	path which is used to determine the filesystem match.
2238 *
2239 * Results:
2240 *	Standard Tcl return code.
2241 *
2242 * Side effects:
2243 *	An attempt may be made to convert the object.
2244 *
2245 *---------------------------------------------------------------------------
2246 */
2247
2248int
2249TclFSEnsureEpochOk(
2250    Tcl_Obj *pathPtr,
2251    Tcl_Filesystem **fsPtrPtr)
2252{
2253    FsPath *srcFsPathPtr;
2254
2255    if (pathPtr->typePtr != &tclFsPathType) {
2256	return TCL_OK;
2257    }
2258
2259    srcFsPathPtr = PATHOBJ(pathPtr);
2260
2261    /*
2262     * Check if the filesystem has changed in some way since this object's
2263     * internal representation was calculated.
2264     */
2265
2266    if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) {
2267	/*
2268	 * We have to discard the stale representation and recalculate it.
2269	 */
2270
2271	if (pathPtr->bytes == NULL) {
2272	    UpdateStringOfFsPath(pathPtr);
2273	}
2274	FreeFsPathInternalRep(pathPtr);
2275	pathPtr->typePtr = NULL;
2276	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
2277	    return TCL_ERROR;
2278	}
2279	srcFsPathPtr = PATHOBJ(pathPtr);
2280    }
2281
2282    /*
2283     * Check whether the object is already assigned to a fs.
2284     */
2285
2286    if (srcFsPathPtr->fsRecPtr != NULL) {
2287	*fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
2288    }
2289    return TCL_OK;
2290}
2291
2292/*
2293 *---------------------------------------------------------------------------
2294 *
2295 * TclFSSetPathDetails --
2296 *
2297 *	???
2298 *
2299 * Results:
2300 *	None
2301 *
2302 * Side effects:
2303 *	???
2304 *
2305 *---------------------------------------------------------------------------
2306 */
2307
2308void
2309TclFSSetPathDetails(
2310    Tcl_Obj *pathPtr,
2311    FilesystemRecord *fsRecPtr,
2312    ClientData clientData)
2313{
2314    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
2315    FsPath *srcFsPathPtr;
2316
2317    /*
2318     * Make sure pathPtr is of the correct type.
2319     */
2320
2321    if (pathPtr->typePtr != &tclFsPathType) {
2322	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
2323	    return;
2324	}
2325    }
2326
2327    srcFsPathPtr = PATHOBJ(pathPtr);
2328    srcFsPathPtr->fsRecPtr = fsRecPtr;
2329    srcFsPathPtr->nativePathPtr = clientData;
2330    srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
2331    fsRecPtr->fileRefCount++;
2332}
2333
2334/*
2335 *---------------------------------------------------------------------------
2336 *
2337 * Tcl_FSEqualPaths --
2338 *
2339 *	This function tests whether the two paths given are equal path
2340 *	objects. If either or both is NULL, 0 is always returned.
2341 *
2342 * Results:
2343 *	1 or 0.
2344 *
2345 * Side effects:
2346 *	None.
2347 *
2348 *---------------------------------------------------------------------------
2349 */
2350
2351int
2352Tcl_FSEqualPaths(
2353    Tcl_Obj *firstPtr,
2354    Tcl_Obj *secondPtr)
2355{
2356    char *firstStr, *secondStr;
2357    int firstLen, secondLen, tempErrno;
2358
2359    if (firstPtr == secondPtr) {
2360	return 1;
2361    }
2362
2363    if (firstPtr == NULL || secondPtr == NULL) {
2364	return 0;
2365    }
2366    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
2367    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
2368    if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
2369	return 1;
2370    }
2371
2372    /*
2373     * Try the most thorough, correct method of comparing fully normalized
2374     * paths.
2375     */
2376
2377    tempErrno = Tcl_GetErrno();
2378    firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
2379    secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
2380    Tcl_SetErrno(tempErrno);
2381
2382    if (firstPtr == NULL || secondPtr == NULL) {
2383	return 0;
2384    }
2385
2386    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
2387    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
2388    return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0);
2389}
2390
2391/*
2392 *---------------------------------------------------------------------------
2393 *
2394 * SetFsPathFromAny --
2395 *
2396 *	This function tries to convert the given Tcl_Obj to a valid Tcl path
2397 *	type.
2398 *
2399 *	The filename may begin with "~" (to indicate current user's home
2400 *	directory) or "~<user>" (to indicate any user's home directory).
2401 *
2402 * Results:
2403 *	Standard Tcl error code.
2404 *
2405 * Side effects:
2406 *	The old representation may be freed, and new memory allocated.
2407 *
2408 *---------------------------------------------------------------------------
2409 */
2410
2411static int
2412SetFsPathFromAny(
2413    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
2414    Tcl_Obj *pathPtr)		/* The object to convert. */
2415{
2416    int len;
2417    FsPath *fsPathPtr;
2418    Tcl_Obj *transPtr;
2419    char *name;
2420#if defined(__CYGWIN__) && defined(__WIN32__)
2421    int copied = 0;
2422#endif
2423    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
2424
2425    if (pathPtr->typePtr == &tclFsPathType) {
2426	return TCL_OK;
2427    }
2428
2429    /*
2430     * First step is to translate the filename. This is similar to
2431     * Tcl_TranslateFilename, but shouldn't convert everything to windows
2432     * backslashes on that platform. The current implementation of this piece
2433     * is a slightly optimised version of the various Tilde/Split/Join stuff
2434     * to avoid multiple split/join operations.
2435     *
2436     * We remove any trailing directory separator.
2437     *
2438     * However, the split/join routines are quite complex, and one has to make
2439     * sure not to break anything on Unix or Win (fCmd.test, fileName.test and
2440     * cmdAH.test exercise most of the code).
2441     */
2442
2443    name = Tcl_GetStringFromObj(pathPtr, &len);
2444
2445    /*
2446     * Handle tilde substitutions, if needed.
2447     */
2448
2449    if (name[0] == '~') {
2450	char *expandedUser;
2451	Tcl_DString temp;
2452	int split;
2453	char separator = '/';
2454
2455	split = FindSplitPos(name, separator);
2456	if (split != len) {
2457	    /*
2458	     * We have multiple pieces '~user/foo/bar...'
2459	     */
2460
2461	    name[split] = '\0';
2462	}
2463
2464	/*
2465	 * Do some tilde substitution.
2466	 */
2467
2468	if (name[1] == '\0') {
2469	    /*
2470	     * We have just '~'
2471	     */
2472
2473	    const char *dir;
2474	    Tcl_DString dirString;
2475
2476	    if (split != len) {
2477		name[split] = separator;
2478	    }
2479
2480	    dir = TclGetEnv("HOME", &dirString);
2481	    if (dir == NULL) {
2482		if (interp) {
2483		    Tcl_ResetResult(interp);
2484		    Tcl_AppendResult(interp, "couldn't find HOME environment "
2485			    "variable to expand path", NULL);
2486		}
2487		return TCL_ERROR;
2488	    }
2489	    Tcl_DStringInit(&temp);
2490	    Tcl_JoinPath(1, &dir, &temp);
2491	    Tcl_DStringFree(&dirString);
2492	} else {
2493	    /*
2494	     * We have a user name '~user'
2495	     */
2496
2497	    Tcl_DStringInit(&temp);
2498	    if (TclpGetUserHome(name+1, &temp) == NULL) {
2499		if (interp != NULL) {
2500		    Tcl_ResetResult(interp);
2501		    Tcl_AppendResult(interp, "user \"", name+1,
2502			    "\" doesn't exist", NULL);
2503		}
2504		Tcl_DStringFree(&temp);
2505		if (split != len) {
2506		    name[split] = separator;
2507		}
2508		return TCL_ERROR;
2509	    }
2510	    if (split != len) {
2511		name[split] = separator;
2512	    }
2513	}
2514
2515	expandedUser = Tcl_DStringValue(&temp);
2516	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
2517
2518	if (split != len) {
2519	    /*
2520	     * Join up the tilde substitution with the rest.
2521	     */
2522
2523	    if (name[split+1] == separator) {
2524		/*
2525		 * Somewhat tricky case like ~//foo/bar. Make use of
2526		 * Split/Join machinery to get it right. Assumes all paths
2527		 * beginning with ~ are part of the native filesystem.
2528		 */
2529
2530		int objc;
2531		Tcl_Obj **objv;
2532		Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL);
2533
2534		Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
2535
2536		/*
2537		 * Skip '~'. It's replaced by its expansion.
2538		 */
2539
2540		objc--; objv++;
2541		while (objc--) {
2542		    TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
2543		}
2544		TclDecrRefCount(parts);
2545	    } else {
2546		/*
2547		 * Simple case. "rest" is relative path. Just join it. The
2548		 * "rest" object will be freed when Tcl_FSJoinToPath returns
2549		 * (unless something else claims a refCount on it).
2550		 */
2551
2552		Tcl_Obj *joined;
2553		Tcl_Obj *rest = Tcl_NewStringObj(name+split+1, -1);
2554
2555		Tcl_IncrRefCount(transPtr);
2556		joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
2557		TclDecrRefCount(transPtr);
2558		transPtr = joined;
2559	    }
2560	}
2561	Tcl_DStringFree(&temp);
2562    } else {
2563	transPtr = Tcl_FSJoinToPath(pathPtr, 0, NULL);
2564    }
2565
2566#if defined(__CYGWIN__) && defined(__WIN32__)
2567    {
2568	char winbuf[MAX_PATH+1];
2569
2570	/*
2571	 * In the Cygwin world, call conv_to_win32_path in order to use the
2572	 * mount table to translate the file name into something Windows will
2573	 * understand. Take care when converting empty strings!
2574	 */
2575
2576	name = Tcl_GetStringFromObj(transPtr, &len);
2577	if (len > 0) {
2578	    cygwin_conv_to_win32_path(name, winbuf);
2579	    TclWinNoBackslash(winbuf);
2580	    if (Tcl_IsShared(transPtr)) {
2581		copied = 1;
2582		transPtr = Tcl_DuplicateObj(transPtr);
2583		Tcl_IncrRefCount(transPtr);
2584	    }
2585	    Tcl_SetStringObj(transPtr, winbuf, -1);
2586	}
2587    }
2588#endif /* __CYGWIN__ && __WIN32__ */
2589
2590    /*
2591     * Now we have a translated filename in 'transPtr'. This will have forward
2592     * slashes on Windows, and will not contain any ~user sequences.
2593     */
2594
2595    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
2596
2597    fsPathPtr->translatedPathPtr = transPtr;
2598    if (transPtr != pathPtr) {
2599	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
2600    }
2601    fsPathPtr->normPathPtr = NULL;
2602    fsPathPtr->cwdPtr = NULL;
2603    fsPathPtr->nativePathPtr = NULL;
2604    fsPathPtr->fsRecPtr = NULL;
2605    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
2606
2607    /*
2608     * Free old representation before installing our new one.
2609     */
2610
2611    TclFreeIntRep(pathPtr);
2612    SETPATHOBJ(pathPtr, fsPathPtr);
2613    PATHFLAGS(pathPtr) = 0;
2614    pathPtr->typePtr = &tclFsPathType;
2615#if defined(__CYGWIN__) && defined(__WIN32__)
2616    if (copied) {
2617	Tcl_DecrRefCount(transPtr);
2618    }
2619#endif
2620
2621    return TCL_OK;
2622}
2623
2624static void
2625FreeFsPathInternalRep(
2626    Tcl_Obj *pathPtr)		/* Path object with internal rep to free. */
2627{
2628    FsPath *fsPathPtr = PATHOBJ(pathPtr);
2629
2630    if (fsPathPtr->translatedPathPtr != NULL) {
2631	if (fsPathPtr->translatedPathPtr != pathPtr) {
2632	    TclDecrRefCount(fsPathPtr->translatedPathPtr);
2633	}
2634    }
2635    if (fsPathPtr->normPathPtr != NULL) {
2636	if (fsPathPtr->normPathPtr != pathPtr) {
2637	    TclDecrRefCount(fsPathPtr->normPathPtr);
2638	}
2639	fsPathPtr->normPathPtr = NULL;
2640    }
2641    if (fsPathPtr->cwdPtr != NULL) {
2642	TclDecrRefCount(fsPathPtr->cwdPtr);
2643    }
2644    if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsRecPtr != NULL) {
2645	Tcl_FSFreeInternalRepProc *freeProc =
2646		fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc;
2647
2648	if (freeProc != NULL) {
2649	    (*freeProc)(fsPathPtr->nativePathPtr);
2650	    fsPathPtr->nativePathPtr = NULL;
2651	}
2652    }
2653    if (fsPathPtr->fsRecPtr != NULL) {
2654	fsPathPtr->fsRecPtr->fileRefCount--;
2655	if (fsPathPtr->fsRecPtr->fileRefCount <= 0) {
2656	    /*
2657	     * It has been unregistered already.
2658	     */
2659
2660	    ckfree((char *) fsPathPtr->fsRecPtr);
2661	}
2662    }
2663
2664    ckfree((char *) fsPathPtr);
2665}
2666
2667static void
2668DupFsPathInternalRep(
2669    Tcl_Obj *srcPtr,		/* Path obj with internal rep to copy. */
2670    Tcl_Obj *copyPtr)		/* Path obj with internal rep to set. */
2671{
2672    FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
2673    FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));
2674
2675    SETPATHOBJ(copyPtr, copyFsPathPtr);
2676
2677    if (srcFsPathPtr->translatedPathPtr != NULL) {
2678	copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
2679	if (copyFsPathPtr->translatedPathPtr != copyPtr) {
2680	    Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
2681	}
2682    } else {
2683	copyFsPathPtr->translatedPathPtr = NULL;
2684    }
2685
2686    if (srcFsPathPtr->normPathPtr != NULL) {
2687	copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
2688	if (copyFsPathPtr->normPathPtr != copyPtr) {
2689	    Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
2690	}
2691    } else {
2692	copyFsPathPtr->normPathPtr = NULL;
2693    }
2694
2695    if (srcFsPathPtr->cwdPtr != NULL) {
2696	copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
2697	Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
2698    } else {
2699	copyFsPathPtr->cwdPtr = NULL;
2700    }
2701
2702    copyFsPathPtr->flags = srcFsPathPtr->flags;
2703
2704    if (srcFsPathPtr->fsRecPtr != NULL
2705	    && srcFsPathPtr->nativePathPtr != NULL) {
2706	Tcl_FSDupInternalRepProc *dupProc =
2707		srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
2708
2709	if (dupProc != NULL) {
2710	    copyFsPathPtr->nativePathPtr =
2711		    (*dupProc)(srcFsPathPtr->nativePathPtr);
2712	} else {
2713	    copyFsPathPtr->nativePathPtr = NULL;
2714	}
2715    } else {
2716	copyFsPathPtr->nativePathPtr = NULL;
2717    }
2718    copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
2719    copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
2720    if (copyFsPathPtr->fsRecPtr != NULL) {
2721	copyFsPathPtr->fsRecPtr->fileRefCount++;
2722    }
2723
2724    copyPtr->typePtr = &tclFsPathType;
2725}
2726
2727/*
2728 *---------------------------------------------------------------------------
2729 *
2730 * UpdateStringOfFsPath --
2731 *
2732 *	Gives an object a valid string rep.
2733 *
2734 * Results:
2735 *	None.
2736 *
2737 * Side effects:
2738 *	Memory may be allocated.
2739 *
2740 *---------------------------------------------------------------------------
2741 */
2742
2743static void
2744UpdateStringOfFsPath(
2745    register Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
2746{
2747    FsPath *fsPathPtr = PATHOBJ(pathPtr);
2748    int cwdLen;
2749    Tcl_Obj *copy;
2750
2751    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
2752	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
2753    }
2754
2755    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
2756
2757    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
2758    pathPtr->length = cwdLen;
2759    copy->bytes = tclEmptyStringRep;
2760    copy->length = 0;
2761    TclDecrRefCount(copy);
2762}
2763
2764/*
2765 *---------------------------------------------------------------------------
2766 *
2767 * TclNativePathInFilesystem --
2768 *
2769 *	Any path object is acceptable to the native filesystem, by default (we
2770 *	will throw errors when illegal paths are actually tried to be used).
2771 *
2772 *	However, this behavior means the native filesystem must be the last
2773 *	filesystem in the lookup list (otherwise it will claim all files
2774 *	belong to it, and other filesystems will never get a look in).
2775 *
2776 * Results:
2777 *	TCL_OK, to indicate 'yes', -1 to indicate no.
2778 *
2779 * Side effects:
2780 *	None.
2781 *
2782 *---------------------------------------------------------------------------
2783 */
2784
2785int
2786TclNativePathInFilesystem(
2787    Tcl_Obj *pathPtr,
2788    ClientData *clientDataPtr)
2789{
2790    /*
2791     * A special case is required to handle the empty path "". This is a valid
2792     * path (i.e. the user should be able to do 'file exists ""' without
2793     * throwing an error), but equally the path doesn't exist. Those are the
2794     * semantics of Tcl (at present anyway), so we have to abide by them here.
2795     */
2796
2797    if (pathPtr->typePtr == &tclFsPathType) {
2798	if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
2799	    /*
2800	     * We reject the empty path "".
2801	     */
2802
2803	    return -1;
2804	}
2805
2806	/*
2807	 * Otherwise there is no way this path can be empty.
2808	 */
2809    } else {
2810	/*
2811	 * It is somewhat unusual to reach this code path without the object
2812	 * being of tclFsPathType. However, we do our best to deal with the
2813	 * situation.
2814	 */
2815
2816	int len;
2817
2818	(void) Tcl_GetStringFromObj(pathPtr, &len);
2819	if (len == 0) {
2820	    /*
2821	     * We reject the empty path "".
2822	     */
2823
2824	    return -1;
2825	}
2826    }
2827
2828    /*
2829     * Path is of correct type, or is of non-zero length, so we accept it.
2830     */
2831
2832    return TCL_OK;
2833}
2834
2835/*
2836 * Local Variables:
2837 * mode: c
2838 * c-basic-offset: 4
2839 * fill-column: 78
2840 * End:
2841 */
2842