diff options
Diffstat (limited to 'generic/tclFileName.c')
| -rw-r--r-- | generic/tclFileName.c | 300 |
1 files changed, 81 insertions, 219 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 5d4702b..07757d9 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 /* *---------------------------------------------------------------------- @@ -72,9 +62,9 @@ SetResultLength( { Tcl_DStringSetLength(resultPtr, offset); if (extended == 2) { - TclDStringAppendLiteral(resultPtr, "//?/UNC/"); + Tcl_DStringAppend(resultPtr, "//?/UNC/", 8); } else if (extended == 1) { - TclDStringAppendLiteral(resultPtr, "//?/"); + Tcl_DStringAppend(resultPtr, "//?/", 4); } } @@ -131,7 +121,7 @@ ExtractWinRoot( if (path[1] != '/' && path[1] != '\\') { SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; - TclDStringAppendLiteral(resultPtr, "/"); + Tcl_DStringAppend(resultPtr, "/", 1); return &path[1]; } host = &path[2]; @@ -161,7 +151,7 @@ ExtractWinRoot( */ *typePtr = TCL_PATH_VOLUME_RELATIVE; - TclDStringAppendLiteral(resultPtr, "/"); + Tcl_DStringAppend(resultPtr, "/", 1); return &path[2]; } SetResultLength(resultPtr, offset, extended); @@ -180,9 +170,9 @@ ExtractWinRoot( break; } } - TclDStringAppendLiteral(resultPtr, "//"); + Tcl_DStringAppend(resultPtr, "//", 2); Tcl_DStringAppend(resultPtr, host, hlen); - TclDStringAppendLiteral(resultPtr, "/"); + Tcl_DStringAppend(resultPtr, "/", 1); Tcl_DStringAppend(resultPtr, share, slen); tail = &share[slen]; @@ -221,7 +211,7 @@ ExtractWinRoot( *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringAppend(resultPtr, path, 2); - TclDStringAppendLiteral(resultPtr, "/"); + Tcl_DStringAppend(resultPtr, "/", 1); return tail; } @@ -456,7 +446,8 @@ TclpGetNativePathType( if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { *driveNameLengthPtr = rootEnd - path; if (driveNameRef != NULL) { - *driveNameRef = TclDStringToObj(&ds); + *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); Tcl_IncrRefCount(*driveNameRef); } } @@ -587,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 @@ -745,7 +737,8 @@ SplitWinPath( */ if (p != path) { - Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf)); + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj( + Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); } Tcl_DStringFree(&buf); @@ -807,28 +800,32 @@ Tcl_FSJoinToPath( int objc, /* Number of array elements to join */ Tcl_Obj *const objv[]) /* Path elements to join. */ { + int i; + Tcl_Obj *lobj, *ret; + if (pathPtr == NULL) { - return TclJoinPath(objc, objv); - } - if (objc == 0) { - return TclJoinPath(1, &pathPtr); + lobj = Tcl_NewListObj(0, NULL); + } else { + lobj = Tcl_NewListObj(1, &pathPtr); } - if (objc == 1) { - Tcl_Obj *pair[2]; - pair[0] = pathPtr; - pair[1] = objv[0]; - return TclJoinPath(2, pair); - } else { - int elemc = objc + 1; - Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj **)); - - elemv[0] = pathPtr; - memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj **)); - ret = TclJoinPath(elemc, elemv); - ckfree(elemv); - return ret; + for (i = 0; i<objc;i++) { + Tcl_ListObjAppendElement(NULL, lobj, objv[i]); } + ret = Tcl_FSJoinPath(lobj, -1); + + /* + * It is possible that 'ret' is just a member of the list and is therefore + * going to be freed here. Therefore we must adjust the refCount manually. + * (It would be better if we changed the documentation of this function + * and Tcl_FSJoinPath so that the returned object already has a refCount + * for the caller, hence avoiding these subtleties (and code ugliness)). + */ + + Tcl_IncrRefCount(ret); + Tcl_DecrRefCount(lobj); + ret->refCount--; + return ret; } /* @@ -1062,7 +1059,7 @@ Tcl_TranslateFileName( } Tcl_DStringInit(bufferPtr); - TclDStringAppendObj(bufferPtr, transPtr); + Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); @@ -1179,10 +1176,9 @@ DoTildeSubst( dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment " - "variable to expand path", -1)); - Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't find HOME environment " + "variable to expand path", NULL); } return NULL; } @@ -1191,9 +1187,8 @@ DoTildeSubst( } else if (TclpGetUserHome(user, resultPtr) == NULL) { if (interp) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL); + Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist", + NULL); } return NULL; } @@ -1228,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 }; @@ -1276,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; @@ -1301,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; @@ -1319,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]; @@ -1335,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_SetObjResult(interp, Tcl_NewStringObj( + Tcl_AppendResult(interp, "\"-tails\" must be used with either " - "\"-directory\" or \"-path\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", - "BADOPTIONCOMBINATION", NULL); + "\"-directory\" or \"-path\"", NULL); return TCL_ERROR; } @@ -1420,7 +1410,7 @@ Tcl_GlobObjCmd( search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); - TclDStringAppendLiteral(&prefix, "\\"); + Tcl_DStringAppend(&prefix, "\\", 1); Tcl_DStringAppend(&prefix, find, 1); search = find+1; if (*search == '\0') { @@ -1449,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; @@ -1546,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; @@ -1559,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; } @@ -1582,7 +1572,8 @@ Tcl_GlobObjCmd( Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { - TclDStringAppendObj(&prefix, objv[i]); + string = Tcl_GetStringFromObj(objv[i], &length); + Tcl_DStringAppend(&prefix, string, length); if (i != objc -1) { Tcl_DStringAppend(&prefix, separators, 1); } @@ -1598,9 +1589,11 @@ Tcl_GlobObjCmd( for (i = 0; i < objc; i++) { Tcl_DStringInit(&str); if (dir == PATH_GENERAL) { - TclDStringAppendDString(&str, &prefix); + Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix), + Tcl_DStringLength(&prefix)); } - TclDStringAppendObj(&str, objv[i]); + string = Tcl_GetStringFromObj(objv[i], &length); + Tcl_DStringAppend(&str, string, length); if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; @@ -1632,25 +1625,19 @@ Tcl_GlobObjCmd( } if (length == 0) { - Tcl_Obj *errorMsg = - Tcl_ObjPrintf("no files matched glob pattern%s \"", - (join || (objc == 1)) ? "" : "s"); - + Tcl_AppendResult(interp, "no files matched glob pattern", + (join || (objc == 1)) ? " \"" : "s \"", NULL); if (join) { - Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1); + Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL); } else { const char *sep = ""; - for (i = 0; i < objc; i++) { - Tcl_AppendPrintfToObj(errorMsg, "%s%s", - sep, Tcl_GetString(objv[i])); + string = Tcl_GetString(objv[i]); + Tcl_AppendResult(interp, sep, string, NULL); sep = " "; } } - Tcl_AppendToObj(errorMsg, "\"", -1); - Tcl_SetObjResult(interp, errorMsg); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH", - NULL); + Tcl_AppendResult(interp, "\"", NULL); result = TCL_ERROR; } } @@ -1773,7 +1760,8 @@ TclGlob( if (head != Tcl_DStringValue(&buffer)) { Tcl_DStringAppend(&buffer, head, -1); } - pathPrefix = TclDStringToObj(&buffer); + pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer), + Tcl_DStringLength(&buffer)); Tcl_IncrRefCount(pathPrefix); globFlags |= TCL_GLOBMODE_DIR; if (c != '\0') { @@ -2217,17 +2205,13 @@ DoGlob( closeBrace = p; break; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched open-brace in file name", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", - NULL); + Tcl_SetResult(interp, "unmatched open-brace in file name", + TCL_STATIC); return TCL_ERROR; } else if (*p == '}') { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched close-brace in file name", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", - NULL); + Tcl_SetResult(interp, "unmatched close-brace in file name", + TCL_STATIC); return TCL_ERROR; } } @@ -2409,9 +2393,9 @@ DoGlob( if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) || (*name == '/')) { - TclDStringAppendLiteral(&append, "/"); + Tcl_DStringAppend(&append, "/", 1); } else { - TclDStringAppendLiteral(&append, "."); + Tcl_DStringAppend(&append, ".", 1); } } @@ -2420,9 +2404,9 @@ DoGlob( case TCL_PLATFORM_UNIX: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { - TclDStringAppendLiteral(&append, "/"); + Tcl_DStringAppend(&append, "/", 1); } else { - TclDStringAppendLiteral(&append, "."); + Tcl_DStringAppend(&append, ".", 1); } } break; @@ -2433,7 +2417,8 @@ DoGlob( */ if (pathPtr == NULL) { - joinedPtr = TclDStringToObj(&append); + joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append), + Tcl_DStringLength(&append)); } else if (flags) { joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append), Tcl_DStringLength(&append)); @@ -2522,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)); } /* |