diff options
Diffstat (limited to 'generic/tclFileName.c')
| -rw-r--r-- | generic/tclFileName.c | 300 |
1 files changed, 219 insertions, 81 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 07757d9..5d4702b 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -37,6 +37,16 @@ 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 /* *---------------------------------------------------------------------- @@ -62,9 +72,9 @@ SetResultLength( { Tcl_DStringSetLength(resultPtr, offset); if (extended == 2) { - Tcl_DStringAppend(resultPtr, "//?/UNC/", 8); + TclDStringAppendLiteral(resultPtr, "//?/UNC/"); } else if (extended == 1) { - Tcl_DStringAppend(resultPtr, "//?/", 4); + TclDStringAppendLiteral(resultPtr, "//?/"); } } @@ -121,7 +131,7 @@ ExtractWinRoot( if (path[1] != '/' && path[1] != '\\') { SetResultLength(resultPtr, offset, extended); *typePtr = TCL_PATH_VOLUME_RELATIVE; - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return &path[1]; } host = &path[2]; @@ -151,7 +161,7 @@ ExtractWinRoot( */ *typePtr = TCL_PATH_VOLUME_RELATIVE; - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return &path[2]; } SetResultLength(resultPtr, offset, extended); @@ -170,9 +180,9 @@ ExtractWinRoot( break; } } - Tcl_DStringAppend(resultPtr, "//", 2); + TclDStringAppendLiteral(resultPtr, "//"); Tcl_DStringAppend(resultPtr, host, hlen); - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); Tcl_DStringAppend(resultPtr, share, slen); tail = &share[slen]; @@ -211,7 +221,7 @@ ExtractWinRoot( *typePtr = TCL_PATH_ABSOLUTE; Tcl_DStringAppend(resultPtr, path, 2); - Tcl_DStringAppend(resultPtr, "/", 1); + TclDStringAppendLiteral(resultPtr, "/"); return tail; } @@ -446,8 +456,7 @@ TclpGetNativePathType( if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { *driveNameLengthPtr = rootEnd - path; if (driveNameRef != NULL) { - *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); + *driveNameRef = TclDStringToObj(&ds); Tcl_IncrRefCount(*driveNameRef); } } @@ -578,8 +587,7 @@ Tcl_SplitPath( * plus the argv pointers and the terminating NULL pointer. */ - *argvPtr = (const char **) ckalloc((unsigned) - ((((*argcPtr) + 1) * sizeof(char *)) + size)); + *argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size); /* * Position p after the last argv pointer and copy the contents of the @@ -737,8 +745,7 @@ SplitWinPath( */ if (p != path) { - Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj( - Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); + Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf)); } Tcl_DStringFree(&buf); @@ -800,32 +807,28 @@ 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) { - lobj = Tcl_NewListObj(0, NULL); - } else { - lobj = Tcl_NewListObj(1, &pathPtr); + return TclJoinPath(objc, objv); } - - for (i = 0; i<objc;i++) { - Tcl_ListObjAppendElement(NULL, lobj, objv[i]); + if (objc == 0) { + return TclJoinPath(1, &pathPtr); } - 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)). - */ + if (objc == 1) { + Tcl_Obj *pair[2]; - Tcl_IncrRefCount(ret); - Tcl_DecrRefCount(lobj); - ret->refCount--; - return ret; + 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; + } } /* @@ -1059,7 +1062,7 @@ Tcl_TranslateFileName( } Tcl_DStringInit(bufferPtr); - Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); + TclDStringAppendObj(bufferPtr, transPtr); Tcl_DecrRefCount(path); Tcl_DecrRefCount(transPtr); @@ -1176,9 +1179,10 @@ DoTildeSubst( dir = TclGetEnv("HOME", &dirString); if (dir == NULL) { if (interp) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't find HOME environment " - "variable to expand path", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "couldn't find HOME environment " + "variable to expand path", -1)); + Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL); } return NULL; } @@ -1187,8 +1191,9 @@ DoTildeSubst( } else if (TclpGetUserHome(user, resultPtr) == NULL) { if (interp) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "user \"%s\" doesn't exist", user)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL); } return NULL; } @@ -1223,10 +1228,10 @@ Tcl_GlobObjCmd( int index, i, globFlags, length, join, dir, result; char *string; const char *separators; - Tcl_Obj *typePtr, *resultPtr, *look; + Tcl_Obj *typePtr, *look; Tcl_Obj *pathOrDir = NULL; Tcl_DString prefix; - static const char *options[] = { + static const char *const options[] = { "-directory", "-join", "-nocomplain", "-path", "-tails", "-types", "--", NULL }; @@ -1271,11 +1276,14 @@ 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; @@ -1293,11 +1301,14 @@ 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; @@ -1308,6 +1319,7 @@ 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]; @@ -1323,14 +1335,12 @@ 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, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-tails\" must be used with either " - "\"-directory\" or \"-path\"", NULL); + "\"-directory\" or \"-path\"", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", + "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; } @@ -1410,7 +1420,7 @@ Tcl_GlobObjCmd( search = Tcl_DStringValue(&pref); while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) { Tcl_DStringAppend(&prefix, search, find-search); - Tcl_DStringAppend(&prefix, "\\", 1); + TclDStringAppendLiteral(&prefix, "\\"); Tcl_DStringAppend(&prefix, find, 1); search = find+1; if (*search == '\0') { @@ -1439,8 +1449,7 @@ Tcl_GlobObjCmd( if (length <= 0) { goto skipTypes; } - globTypes = (Tcl_GlobTypeData*) - TclStackAlloc(interp,sizeof(Tcl_GlobTypeData)); + globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData)); globTypes->type = 0; globTypes->perm = 0; globTypes->macType = NULL; @@ -1537,10 +1546,10 @@ Tcl_GlobObjCmd( */ badTypesArg: - TclNewObj(resultPtr); - Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1); - Tcl_AppendObjToObj(resultPtr, look); - Tcl_SetObjResult(interp, resultPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument to \"-types\": %s", + Tcl_GetString(look))); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); result = TCL_ERROR; join = 0; goto endOfGlob; @@ -1550,6 +1559,7 @@ 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; } @@ -1572,8 +1582,7 @@ Tcl_GlobObjCmd( Tcl_DStringInit(&prefix); } for (i = 0; i < objc; i++) { - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_DStringAppend(&prefix, string, length); + TclDStringAppendObj(&prefix, objv[i]); if (i != objc -1) { Tcl_DStringAppend(&prefix, separators, 1); } @@ -1589,11 +1598,9 @@ Tcl_GlobObjCmd( for (i = 0; i < objc; i++) { Tcl_DStringInit(&str); if (dir == PATH_GENERAL) { - Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix), - Tcl_DStringLength(&prefix)); + TclDStringAppendDString(&str, &prefix); } - string = Tcl_GetStringFromObj(objv[i], &length); - Tcl_DStringAppend(&str, string, length); + TclDStringAppendObj(&str, objv[i]); if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags, globTypes) != TCL_OK) { result = TCL_ERROR; @@ -1625,19 +1632,25 @@ Tcl_GlobObjCmd( } if (length == 0) { - Tcl_AppendResult(interp, "no files matched glob pattern", - (join || (objc == 1)) ? " \"" : "s \"", NULL); + Tcl_Obj *errorMsg = + Tcl_ObjPrintf("no files matched glob pattern%s \"", + (join || (objc == 1)) ? "" : "s"); + if (join) { - Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL); + Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1); } else { const char *sep = ""; + for (i = 0; i < objc; i++) { - string = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, sep, string, NULL); + Tcl_AppendPrintfToObj(errorMsg, "%s%s", + sep, Tcl_GetString(objv[i])); sep = " "; } } - Tcl_AppendResult(interp, "\"", NULL); + Tcl_AppendToObj(errorMsg, "\"", -1); + Tcl_SetObjResult(interp, errorMsg); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH", + NULL); result = TCL_ERROR; } } @@ -1760,8 +1773,7 @@ TclGlob( if (head != Tcl_DStringValue(&buffer)) { Tcl_DStringAppend(&buffer, head, -1); } - pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer), - Tcl_DStringLength(&buffer)); + pathPrefix = TclDStringToObj(&buffer); Tcl_IncrRefCount(pathPrefix); globFlags |= TCL_GLOBMODE_DIR; if (c != '\0') { @@ -2205,13 +2217,17 @@ DoGlob( closeBrace = p; break; } - Tcl_SetResult(interp, "unmatched open-brace in file name", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unmatched open-brace in file name", -1)); + 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_SetObjResult(interp, Tcl_NewStringObj( + "unmatched close-brace in file name", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", + NULL); return TCL_ERROR; } } @@ -2393,9 +2409,9 @@ DoGlob( if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) || (*name == '/')) { - Tcl_DStringAppend(&append, "/", 1); + TclDStringAppendLiteral(&append, "/"); } else { - Tcl_DStringAppend(&append, ".", 1); + TclDStringAppendLiteral(&append, "."); } } @@ -2404,9 +2420,9 @@ DoGlob( case TCL_PLATFORM_UNIX: if (length == 0 && (Tcl_DStringLength(&append) == 0)) { if ((*name == '\\' && name[1] == '/') || (*name == '/')) { - Tcl_DStringAppend(&append, "/", 1); + TclDStringAppendLiteral(&append, "/"); } else { - Tcl_DStringAppend(&append, ".", 1); + TclDStringAppendLiteral(&append, "."); } } break; @@ -2417,8 +2433,7 @@ DoGlob( */ if (pathPtr == NULL) { - joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append), - Tcl_DStringLength(&append)); + joinedPtr = TclDStringToObj(&append); } else if (flags) { joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append), Tcl_DStringLength(&append)); @@ -2507,7 +2522,130 @@ DoGlob( Tcl_StatBuf * Tcl_AllocStatBuf(void) { - return (Tcl_StatBuf *) ckalloc(sizeof(Tcl_StatBuf)); + 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 } /* |