Tcl Source Code

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclFileSystem.h"


/*
 * Prototypes for functions defined later in this file.
 */

static Tcl_Obj *	AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
static void		DupFsPathInternalRep(Tcl_Obj *srcPtr,

}

Tcl_Obj *
TclJoinPath(
    int elements,
    Tcl_Obj * const objv[])
{
    Tcl_Obj *res = NULL;	/* Resulting path object (container of join) */
    Tcl_Obj *elt;		/* Path part (result if returns part of path) */
    int i;
    const Tcl_Filesystem *fsPtr = NULL;

    for (i = 0; i < elements; i++) {
	int driveNameLength, strEltLen, length;

	Tcl_PathType type;

	char *strElt, *ptr;
	Tcl_Obj *driveName = NULL;

	

	elt = objv[i];

	/*
	 * This is a special case where we can be much more efficient, where
	 * we are joining a single relative path onto an object that is
	 * already of path type. The 'TclNewFSPathObj' call below creates an
	 * object which can be normalized more efficiently. Currently we only
	 * use the special case when we have exactly two elements, but we
	 * could expand that in the future.
         *
         * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
         * to be an absolute path. Added a check for that elt is absolute.
	 */

	if ((i == (elements-2)) && (i == 0)
                && (elt->typePtr == &tclFsPathType)
		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
            Tcl_Obj *tailObj = objv[i+1];


	    type = TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		int len;

		str = TclGetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
		     * This happens if we try to handle the root volume '/'.
		     * There's no need to return a special path object, when
		     * the base itself is just fine!
		     */

		    goto partReturn; /* return elt; */
		}

		/*
		 * If it doesn't begin with '.' and is a unix path or it a
		 * windows path without backslashes, then we can be very
		 * efficient here. (In fact even a windows path with
		 * backslashes can be joined efficiently, but the path object
		 * would not have forward slashes only, and this would
		 * therefore contradict our 'file join' documentation).
		 */

		if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS)
			|| (strchr(str, '\\') == NULL))) {
		    /*
		     * Finally, on Windows, 'file join' is defined to convert
		     * all backslashes to forward slashes, so the base part
		     * cannot have backslashes either.
		     */

		    if ((tclPlatform != TCL_PLATFORM_WINDOWS)
			    || (strchr(Tcl_GetString(elt), '\\') == NULL)
		    ) {
			if (PATHFLAGS(elt)) {
			    elt = TclNewFSPathObj(elt, str, len);
			    goto partReturn; /* return elt; */
			}
			if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) {
			    elt = TclNewFSPathObj(elt, str, len);
			    goto partReturn; /* return elt; */
			}
			(void) Tcl_FSGetNormalizedPath(NULL, elt);
			if (elt == PATHOBJ(elt)->normPathPtr) {
			    elt = TclNewFSPathObj(elt, str, len);
			    goto partReturn; /* return elt; */
			}
		    }
		}

		/*
		 * Otherwise we don't have an easy join, and we must let the
		 * more general code below handle things.
		 */
	    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
		elt = tailObj;
		goto partReturn; /* return elt; */
	    } else {
		const char *str = TclGetString(tailObj);

		if (tclPlatform == TCL_PLATFORM_WINDOWS) {
		    if (strchr(str, '\\') == NULL) {
			elt = tailObj;
			goto partReturn; /* return elt; */
		    }
		}
	    }
	}











	strElt = TclGetStringFromObj(elt, &strEltLen);
	driveNameLength = 0;
	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
	if (type != TCL_PATH_RELATIVE) {
	    /*
	     * Zero out the current result.
	     */

		     * is not in normalized form
		     */

		    goto noQuickReturn;
		}
		ptr++;
	    }




	    /*
	     * This element is just what we want to return already; no further
	     * manipulation is requred.
	     */

	    goto partReturn; /* return elt; */
	}

	/*
	 * The path element was not of a suitable form to be returned as is.
	 * We need to perform a more complex operation here.
	 */

		    needsSep = 1;
		}
	    }
	    length = ptr - TclGetString(res);
	    Tcl_SetObjLength(res, length);
	}
    }
    if (res == NULL) {
	res = Tcl_NewObj();
    }
    return res;

partReturn:
    if (res != NULL) {
	TclDecrRefCount(res);
    }
    return elt;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSConvertToPathType --
 *