diff options
Diffstat (limited to 'generic/tclFileName.c')
| -rw-r--r-- | generic/tclFileName.c | 374 |
1 files changed, 87 insertions, 287 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 8ed6f96..a8360fc 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -37,16 +37,6 @@ static Tcl_Obj * SplitUnixPath(const char *path); static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr, const char *separators, Tcl_Obj *pathPtr, int flags, char *pattern, Tcl_GlobTypeData *types); - -/* - * When there is no support for getting the block size of a file in a stat() - * call, use this as a guess. Allow it to be overridden in the platform- - * specific files. - */ - -#if (!defined(HAVE_STRUCT_STAT_ST_BLKSIZE) && !defined(GUESSED_BLOCK_SIZE)) -#define GUESSED_BLOCK_SIZE 1024 -#endif /* *---------------------------------------------------------------------- @@ -235,9 +225,9 @@ ExtractWinRoot( if ((path[0] == 'c' || path[0] == 'C') && (path[1] == 'o' || path[1] == 'O')) { if ((path[2] == 'm' || path[2] == 'M') - && path[3] >= '1' && path[3] <= '4') { + && path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'com[1-4]:?', which is a serial port. + * May have match for 'com[1-9]:?', which is a serial port. */ if (path[4] == '\0') { @@ -257,9 +247,9 @@ ExtractWinRoot( } else if ((path[0] == 'l' || path[0] == 'L') && (path[1] == 'p' || path[1] == 'P') && (path[2] == 't' || path[2] == 'T')) { - if (path[3] >= '1' && path[3] <= '3') { + if (path[3] >= '1' && path[3] <= '9') { /* - * May have match for 'lpt[1-3]:?' + * May have match for 'lpt[1-9]:?' */ if (path[4] == '\0') { @@ -411,25 +401,36 @@ TclpGetNativePathType( * Paths that begin with / are absolute. */ -#ifdef __QNX__ - /* - * Check for QNX //<node id> prefix - */ - if (*path && (pathLen > 3) && (path[0] == '/') - && (path[1] == '/') && isdigit(UCHAR(path[2]))) { - path += 3; - while (isdigit(UCHAR(*path))) { - path++; + if (path[0] == '/') { + ++path; +#if defined(__CYGWIN__) || defined(__QNX__) + /* + * Check for "//" network path prefix + */ + if ((*path == '/') && path[1] && (path[1] != '/')) { + path += 2; + while (*path && *path != '/') { + ++path; + } +#if defined(__CYGWIN__) + /* UNC paths need to be followed by a share name */ + if (*path++ && (*path && *path != '/')) { + ++path; + while (*path && *path != '/') { + ++path; + } + } else { + path = origPath + 1; + } +#endif } - } #endif - if (path[0] == '/') { if (driveNameLengthPtr != NULL) { /* - * We need this addition in case the QNX code was used. + * We need this addition in case the QNX or Cygwin code was used. */ - *driveNameLengthPtr = (1 + path - origPath); + *driveNameLengthPtr = (path - origPath); } } else { type = TCL_PATH_RELATIVE; @@ -577,7 +578,8 @@ Tcl_SplitPath( * plus the argv pointers and the terminating NULL pointer. */ - *argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size); + *argvPtr = (const char **) ckalloc((unsigned) + ((((*argcPtr) + 1) * sizeof(char *)) + size)); /* * Position p after the last argv pointer and copy the contents of the @@ -633,32 +635,43 @@ SplitUnixPath( const char *path) /* Pointer to string containing a path. */ { int length; - const char *p, *elementStart; + const char *origPath = path, *elementStart; Tcl_Obj *result = Tcl_NewObj(); /* * Deal with the root directory as a special case. */ -#ifdef __QNX__ - /* - * Check for QNX //<node id> prefix - */ - - if ((path[0] == '/') && (path[1] == '/') - && isdigit(UCHAR(path[2]))) { /* INTL: digit */ - path += 3; - while (isdigit(UCHAR(*path))) { /* INTL: digit */ - path++; + if (*path == '/') { + Tcl_Obj *rootElt; + ++path; +#if defined(__CYGWIN__) || defined(__QNX__) + /* + * Check for "//" network path prefix + */ + if ((*path == '/') && path[1] && (path[1] != '/')) { + path += 2; + while (*path && *path != '/') { + ++path; + } +#if defined(__CYGWIN__) + /* UNC paths need to be followed by a share name */ + if (*path++ && (*path && *path != '/')) { + ++path; + while (*path && *path != '/') { + ++path; + } + } else { + path = origPath + 1; + } +#endif } - } #endif - - if (path[0] == '/') { - Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1)); - p = path+1; - } else { - p = path; + rootElt = Tcl_NewStringObj(origPath, path - origPath); + Tcl_ListObjAppendElement(NULL, result, rootElt); + while (*path == '/') { + ++path; + } } /* @@ -667,14 +680,14 @@ SplitUnixPath( */ for (;;) { - elementStart = p; - while ((*p != '\0') && (*p != '/')) { - p++; + elementStart = path; + while ((*path != '\0') && (*path != '/')) { + path++; } - length = p - elementStart; + length = path - elementStart; if (length > 0) { Tcl_Obj *nextElt; - if ((elementStart[0] == '~') && (elementStart != path)) { + if ((elementStart[0] == '~') && (elementStart != origPath)) { TclNewLiteralStringObj(nextElt, "./"); Tcl_AppendToObj(nextElt, elementStart, length); } else { @@ -682,7 +695,7 @@ SplitUnixPath( } Tcl_ListObjAppendElement(NULL, result, nextElt); } - if (*p++ == '\0') { + if (*path++ == '\0') { break; } } @@ -869,7 +882,7 @@ TclpNativeJoinPath( if (length > 0 && (start[length-1] != '/')) { Tcl_AppendToObj(prefix, "/", 1); - length++; + Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; @@ -905,7 +918,7 @@ TclpNativeJoinPath( if ((length > 0) && (start[length-1] != '/') && (start[length-1] != ':')) { Tcl_AppendToObj(prefix, "/", 1); - length++; + Tcl_GetStringFromObj(prefix, &length); } needsSep = 0; @@ -1210,10 +1223,10 @@ Tcl_GlobObjCmd( int index, i, globFlags, length, join, dir, result; char *string; const char *separators; - Tcl_Obj *typePtr, *look; + Tcl_Obj *typePtr, *resultPtr, *look; Tcl_Obj *pathOrDir = NULL; Tcl_DString prefix; - static const char *const options[] = { + static const char *options[] = { "-directory", "-join", "-nocomplain", "-path", "-tails", "-types", "--", NULL }; @@ -1258,14 +1271,11 @@ Tcl_GlobObjCmd( if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-directory\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } if (dir != PATH_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-directory\" cannot be used with \"-path\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", - "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; } dir = PATH_DIR; @@ -1283,14 +1293,11 @@ Tcl_GlobObjCmd( if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-path\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } if (dir != PATH_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-path\" cannot be used with \"-directory\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", - "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; } dir = PATH_GENERAL; @@ -1301,7 +1308,6 @@ Tcl_GlobObjCmd( if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing argument to \"-types\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } typePtr = objv[i+1]; @@ -1317,12 +1323,14 @@ Tcl_GlobObjCmd( } endOfForLoop: + if (objc - i < 1) { + Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?"); + return TCL_ERROR; + } if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) { Tcl_AppendResult(interp, "\"-tails\" must be used with either " "\"-directory\" or \"-path\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", - "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; } @@ -1431,7 +1439,8 @@ Tcl_GlobObjCmd( if (length <= 0) { goto skipTypes; } - globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData)); + globTypes = (Tcl_GlobTypeData*) + TclStackAlloc(interp,sizeof(Tcl_GlobTypeData)); globTypes->type = 0; globTypes->perm = 0; globTypes->macType = NULL; @@ -1528,10 +1537,10 @@ Tcl_GlobObjCmd( */ badTypesArg: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad argument to \"-types\": %s", - Tcl_GetString(look))); - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); + TclNewObj(resultPtr); + Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1); + Tcl_AppendObjToObj(resultPtr, look); + Tcl_SetObjResult(interp, resultPtr); result = TCL_ERROR; join = 0; goto endOfGlob; @@ -1541,7 +1550,6 @@ Tcl_GlobObjCmd( "only one MacOS type or creator argument" " to \"-types\" allowed", -1)); result = TCL_ERROR; - Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); join = 0; goto endOfGlob; } @@ -1623,7 +1631,6 @@ Tcl_GlobObjCmd( Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL); } else { const char *sep = ""; - for (i = 0; i < objc; i++) { string = Tcl_GetString(objv[i]); Tcl_AppendResult(interp, sep, string, NULL); @@ -1631,8 +1638,6 @@ Tcl_GlobObjCmd( } } Tcl_AppendResult(interp, "\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH", - NULL); result = TCL_ERROR; } } @@ -2164,67 +2169,6 @@ DoGlob( } /* - * This block of code is not exercised by the Tcl test suite as of Tcl - * 8.5a0. Simplifications to the calling paths suggest it may not be - * necessary any more, since path separators are handled elsewhere. It is - * left in place in case new bugs are reported. - */ - -#if 0 /* PROBABLY_OBSOLETE */ - /* - * Deal with path separators. - */ - - if (pathPtr == NULL) { - /* - * Length used to be the length of the prefix, and lastChar the - * lastChar of the prefix. But, none of this is used any more. - */ - - int length = 0; - char lastChar = 0; - - switch (tclPlatform) { - case TCL_PLATFORM_WINDOWS: - /* - * If this is a drive relative path, add the colon and the - * trailing slash if needed. Otherwise add the slash if this is - * the first absolute element, or a later relative element. Add an - * extra slash if this is a UNC path. - */ - - if (*name == ':') { - Tcl_DStringAppend(&append, ":", 1); - if (count > 1) { - Tcl_DStringAppend(&append, "/", 1); - } - } else if ((*pattern != '\0') && (((length > 0) - && (strchr(separators, lastChar) == NULL)) - || ((length == 0) && (count > 0)))) { - Tcl_DStringAppend(&append, "/", 1); - if ((length == 0) && (count > 1)) { - Tcl_DStringAppend(&append, "/", 1); - } - } - - break; - case TCL_PLATFORM_UNIX: - /* - * Add a separator if this is the first absolute element, or a - * later relative element. - */ - - if ((*pattern != '\0') && (((length > 0) - && (strchr(separators, lastChar) == NULL)) - || ((length == 0) && (count > 0)))) { - Tcl_DStringAppend(&append, "/", 1); - } - break; - } - } -#endif /* PROBABLY_OBSOLETE */ - - /* * Look for the first matching pair of braces or the first directory * separator that is not inside a pair of braces. */ @@ -2263,15 +2207,11 @@ DoGlob( } Tcl_SetResult(interp, "unmatched open-brace in file name", TCL_STATIC); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", - NULL); return TCL_ERROR; } else if (*p == '}') { Tcl_SetResult(interp, "unmatched close-brace in file name", TCL_STATIC); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", - NULL); return TCL_ERROR; } } @@ -2282,8 +2222,8 @@ DoGlob( if (openBrace != NULL) { char *element; - Tcl_DString newName; + Tcl_DStringInit(&newName); /* @@ -2332,12 +2272,13 @@ DoGlob( */ if (*p != '\0') { + char savedChar = *p; + /* * Note that we are modifying the string in place. This won't work if * the string is a static. */ - char savedChar = *p; *p = '\0'; firstSpecialChar = strpbrk(pattern, "*[]?\\"); *p = savedChar; @@ -2402,6 +2343,7 @@ DoGlob( const char *bytes; int numBytes; Tcl_Obj *fixme, *newObj; + Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme); bytes = Tcl_GetStringFromObj(fixme, &numBytes); newObj = Tcl_NewStringObj(bytes+2, numBytes-2); @@ -2422,6 +2364,9 @@ DoGlob( */ if (*p == '\0') { + int length; + Tcl_DString append; + /* * This is the code path reached by a command like 'glob foo'. * @@ -2434,9 +2379,6 @@ DoGlob( * approach). */ - int length; - Tcl_DString append; - Tcl_DStringInit(&append); Tcl_DStringAppend(&append, pattern, p-pattern); @@ -2457,15 +2399,6 @@ DoGlob( } } -#if defined(__CYGWIN__) && defined(__WIN32__) - { - char winbuf[MAX_PATH+1]; - - cygwin_conv_to_win32_path(Tcl_DStringValue(&append), winbuf); - Tcl_DStringFree(&append); - Tcl_DStringAppend(&append, winbuf, -1); - } -#endif /* __CYGWIN__ && __WIN32__ */ break; case TCL_PLATFORM_UNIX: @@ -2476,16 +2409,6 @@ DoGlob( Tcl_DStringAppend(&append, ".", 1); } } -#if defined(__CYGWIN__) && !defined(__WIN32__) - DLLIMPORT extern int cygwin_conv_to_posix_path(const char *, char *); - { - char winbuf[MAXPATHLEN+1]; - - cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf); - Tcl_DStringFree(&append); - Tcl_DStringAppend(&append, winbuf, -1); - } -#endif /* __CYGWIN__ && __WIN32__ */ break; } @@ -2584,130 +2507,7 @@ DoGlob( Tcl_StatBuf * Tcl_AllocStatBuf(void) { - return ckalloc(sizeof(Tcl_StatBuf)); -} - -/* - *--------------------------------------------------------------------------- - * - * Access functions for Tcl_StatBuf -- - * - * These functions provide portable read-only access to the portable - * fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct - * stat64' or something else related). [TIP #316] - * - * Results: - * The value from the field being retrieved. - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -unsigned -Tcl_GetFSDeviceFromStat( - const Tcl_StatBuf *statPtr) -{ - return (unsigned) statPtr->st_dev; -} - -unsigned -Tcl_GetFSInodeFromStat( - const Tcl_StatBuf *statPtr) -{ - return (unsigned) statPtr->st_ino; -} - -unsigned -Tcl_GetModeFromStat( - const Tcl_StatBuf *statPtr) -{ - return (unsigned) statPtr->st_mode; -} - -int -Tcl_GetLinkCountFromStat( - const Tcl_StatBuf *statPtr) -{ - return (int)statPtr->st_nlink; -} - -int -Tcl_GetUserIdFromStat( - const Tcl_StatBuf *statPtr) -{ - return (int) statPtr->st_uid; -} - -int -Tcl_GetGroupIdFromStat( - const Tcl_StatBuf *statPtr) -{ - return (int) statPtr->st_gid; -} - -int -Tcl_GetDeviceTypeFromStat( - const Tcl_StatBuf *statPtr) -{ - return (int) statPtr->st_rdev; -} - -Tcl_WideInt -Tcl_GetAccessTimeFromStat( - const Tcl_StatBuf *statPtr) -{ - return (Tcl_WideInt) statPtr->st_atime; -} - -Tcl_WideInt -Tcl_GetModificationTimeFromStat( - const Tcl_StatBuf *statPtr) -{ - return (Tcl_WideInt) statPtr->st_mtime; -} - -Tcl_WideInt -Tcl_GetChangeTimeFromStat( - const Tcl_StatBuf *statPtr) -{ - return (Tcl_WideInt) statPtr->st_ctime; -} - -Tcl_WideUInt -Tcl_GetSizeFromStat( - const Tcl_StatBuf *statPtr) -{ - return (Tcl_WideUInt) statPtr->st_size; -} - -Tcl_WideUInt -Tcl_GetBlocksFromStat( - const Tcl_StatBuf *statPtr) -{ -#ifdef HAVE_STRUCT_STAT_ST_BLOCKS - return (Tcl_WideUInt) statPtr->st_blocks; -#else - register unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); - - return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize; -#endif -} - -unsigned -Tcl_GetBlockSizeFromStat( - const Tcl_StatBuf *statPtr) -{ -#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE - return (unsigned) statPtr->st_blksize; -#else - /* - * Not a great guess, but will do... - */ - - return GUESSED_BLOCK_SIZE; -#endif + return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf)); } /* |