summaryrefslogtreecommitdiffstats
path: root/generic/tclFCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclFCmd.c')
-rw-r--r--generic/tclFCmd.c558
1 files changed, 95 insertions, 463 deletions
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 048fa57..c52cd1e 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -11,7 +11,6 @@
*/
#include "tclInt.h"
-#include "tclFileSystem.h"
/*
* Declarations for local functions defined in this file:
@@ -22,9 +21,9 @@ static int CopyRenameOneFile(Tcl_Interp *interp,
int copyFlag, int force);
static Tcl_Obj * FileBasename(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int FileCopyRename(Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[], int copyFlag);
+ int objc, Tcl_Obj *CONST objv[], int copyFlag);
static int FileForceOption(Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[], int *forcePtr);
+ int objc, Tcl_Obj *CONST objv[], int *forcePtr);
/*
*---------------------------------------------------------------------------
@@ -47,11 +46,10 @@ static int FileForceOption(Tcl_Interp *interp,
int
TclFileRenameCmd(
- ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Interp for error reporting or recursive
* calls in the case of a tricky rename. */
int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
+ Tcl_Obj *CONST objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
return FileCopyRename(interp, objc, objv, 0);
}
@@ -76,11 +74,10 @@ TclFileRenameCmd(
int
TclFileCopyCmd(
- ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Used for error reporting or recursive calls
* in the case of a tricky copy. */
int objc, /* Number of arguments. */
- Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
+ Tcl_Obj *CONST objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
return FileCopyRename(interp, objc, objv, 1);
}
@@ -106,7 +103,7 @@ static int
FileCopyRename(
Tcl_Interp *interp, /* Used for error reporting. */
int objc, /* Number of arguments. */
- Tcl_Obj *const objv[], /* Argument strings passed to Tcl_FileCmd. */
+ Tcl_Obj *CONST objv[], /* Argument strings passed to Tcl_FileCmd. */
int copyFlag) /* If non-zero, copy source(s). Otherwise,
* rename them. */
{
@@ -114,20 +111,22 @@ FileCopyRename(
Tcl_StatBuf statBuf;
Tcl_Obj *target;
- i = FileForceOption(interp, objc - 1, objv + 1, &force);
+ i = FileForceOption(interp, objc - 2, objv + 2, &force);
if (i < 0) {
return TCL_ERROR;
}
- i++;
+ i += 2;
if ((objc - i) < 2) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "?-option value ...? source ?source ...? target");
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ TclGetString(objv[0]), " ", TclGetString(objv[1]),
+ " ?options? source ?source ...? target\"", NULL);
return TCL_ERROR;
}
/*
- * If target doesn't exist or isn't a directory, try the copy/rename. More
- * than 2 arguments is only valid if the target is an existing directory.
+ * If target doesn't exist or isn't a directory, try the copy/rename.
+ * More than 2 arguments is only valid if the target is an existing
+ * directory.
*/
target = objv[objc - 1];
@@ -217,25 +216,26 @@ FileCopyRename(
int
TclFileMakeDirsCmd(
- ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Used for error reporting. */
int objc, /* Number of arguments */
- Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
+ Tcl_Obj *CONST objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
- Tcl_Obj *errfile = NULL;
+ Tcl_Obj *errfile;
int result, i, j, pobjc;
Tcl_Obj *split = NULL;
Tcl_Obj *target = NULL;
Tcl_StatBuf statBuf;
+ errfile = NULL;
+
result = TCL_OK;
- for (i = 1; i < objc; i++) {
+ for (i = 2; i < objc; i++) {
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
result = TCL_ERROR;
break;
}
- split = Tcl_FSSplitPath(objv[i], &pobjc);
+ split = Tcl_FSSplitPath(objv[i],&pobjc);
Tcl_IncrRefCount(split);
if (pobjc == 0) {
errno = ENOENT;
@@ -272,17 +272,19 @@ TclFileMakeDirsCmd(
* subdirectory.
*/
- if (errno != EEXIST) {
- errfile = target;
- goto done;
- } else if ((Tcl_FSStat(target, &statBuf) == 0)
- && S_ISDIR(statBuf.st_mode)) {
- /*
- * It is a directory that wasn't there before, so keep
- * going without error.
- */
-
- Tcl_ResetResult(interp);
+ if (errno == EEXIST) {
+ if ((Tcl_FSStat(target, &statBuf) == 0)
+ && S_ISDIR(statBuf.st_mode)) {
+ /*
+ * It is a directory that wasn't there before, so keep
+ * going without error.
+ */
+
+ Tcl_ResetResult(interp);
+ } else {
+ errfile = target;
+ goto done;
+ }
} else {
errfile = target;
goto done;
@@ -334,24 +336,30 @@ TclFileMakeDirsCmd(
int
TclFileDeleteCmd(
- ClientData clientData, /* Unused */
Tcl_Interp *interp, /* Used for error reporting */
int objc, /* Number of arguments */
- Tcl_Obj *const objv[]) /* Argument strings passed to Tcl_FileCmd. */
+ Tcl_Obj *CONST objv[]) /* Argument strings passed to Tcl_FileCmd. */
{
int i, force, result;
Tcl_Obj *errfile;
Tcl_Obj *errorBuffer = NULL;
- i = FileForceOption(interp, objc - 1, objv + 1, &force);
+ i = FileForceOption(interp, objc - 2, objv + 2, &force);
if (i < 0) {
return TCL_ERROR;
}
+ i += 2;
+ if ((objc - i) < 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ TclGetString(objv[0]), " ", TclGetString(objv[1]),
+ " ?options? file ?file ...?\"", NULL);
+ return TCL_ERROR;
+ }
errfile = NULL;
result = TCL_OK;
- for (i++ ; i < objc; i++) {
+ for ( ; i < objc; i++) {
Tcl_StatBuf statBuf;
errfile = objv[i];
@@ -518,7 +526,7 @@ CopyRenameOneFile(
* 16 bits and we get collisions. See bug #2015723.
*/
-#ifndef WIN32
+#if !defined(WIN32) && !defined(__CYGWIN__)
if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
(sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
@@ -734,23 +742,19 @@ CopyRenameOneFile(
*/
errfile = target;
-
- /*
- * We now need to reset the result, because the above call, if it
- * failed, may have put an error message in place. (Ideally we
- * would prefer not to pass an interpreter in above, but the
- * channel IO code used by TclCrossFilesystemCopy currently
- * requires one).
- */
-
- Tcl_ResetResult(interp);
}
+ /*
+ * We now need to reset the result, because the above call,
+ * may have left set it. (Ideally we would prefer not to pass
+ * an interpreter in above, but the channel IO code used by
+ * TclCrossFilesystemCopy currently requires one)
+ */
+ Tcl_ResetResult(interp);
}
if ((copyFlag == 0) && (result == TCL_OK)) {
if (S_ISDIR(sourceStatBuf.st_mode)) {
result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
if (result != TCL_OK) {
- errfile = errorBuffer;
if (Tcl_FSEqualPaths(errfile, source) == 0) {
errfile = source;
}
@@ -812,30 +816,27 @@ static int
FileForceOption(
Tcl_Interp *interp, /* Interp, for error return. */
int objc, /* Number of arguments. */
- Tcl_Obj *const objv[], /* Argument strings. First command line
+ Tcl_Obj *CONST objv[], /* Argument strings. First command line
* option, if it exists, begins at 0. */
int *forcePtr) /* If the "-force" was specified, *forcePtr is
* filled with 1, otherwise with 0. */
{
- int force, i, idx;
- static const char *const options[] = {
- "-force", "--", NULL
- };
+ int force, i;
force = 0;
for (i = 0; i < objc; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
- &idx) != TCL_OK) {
- return -1;
- }
- if (idx == 0 /* -force */) {
+ if (strcmp(TclGetString(objv[i]), "-force") == 0) {
force = 1;
- } else { /* -- */
+ } else if (strcmp(TclGetString(objv[i]), "--") == 0) {
i++;
break;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[i]),
+ "\": should be -force or --", NULL);
+ return -1;
}
}
*forcePtr = force;
@@ -916,13 +917,13 @@ FileBasename(
* Tcl_Interp *interp; The interp to report errors with. Since
* this is an object-based API, the object
* form of the result should be used.
- * const char *fileName; This is extracted using
+ * CONST char *fileName; This is extracted using
* Tcl_TranslateFileName.
* TclObj **attrObjPtrPtr; A new object to hold the attribute is
* allocated and put here.
* The first two parameters of the callback used to write out the
* attributes are the same. The third parameter is:
- * const *attrObjPtr; A pointer to the object that has the new
+ * CONST *attrObjPtr; A pointer to the object that has the new
* attribute.
* They both return standard TCL errors; if the routine to get an
* attribute fails, no object is allocated and *attrObjPtrPtr is
@@ -939,37 +940,32 @@ FileBasename(
int
TclFileAttrsCmd(
- ClientData clientData, /* Unused */
Tcl_Interp *interp, /* The interpreter for error reporting. */
int objc, /* Number of command line arguments. */
- Tcl_Obj *const objv[]) /* The command line objects. */
+ Tcl_Obj *CONST objv[]) /* The command line objects. */
{
int result;
- const char *const *attributeStrings;
- const char **attributeStringsAllocated = NULL;
- Tcl_Obj *objStrings = NULL;
- int numObjStrings = -1;
+ CONST char ** attributeStrings;
+ Tcl_Obj* objStrings = NULL;
+ int numObjStrings = -1, didAlloc = 0;
Tcl_Obj *filePtr;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "name ?option? ?value? ?option value ...?");
return TCL_ERROR;
}
- filePtr = objv[1];
+ filePtr = objv[2];
if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
- objc -= 2;
- objv += 2;
+ objc -= 3;
+ objv += 3;
result = TCL_ERROR;
Tcl_SetErrno(0);
- /*
- * Get the set of attribute names from the filesystem.
- */
-
attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
if (attributeStrings == NULL) {
int index;
@@ -1001,24 +997,18 @@ TclFileAttrsCmd(
if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
goto end;
}
- attributeStringsAllocated = (const char **)
- TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
+ attributeStrings = (CONST char **) TclStackAlloc(interp,
+ (1+numObjStrings) * sizeof(char*));
+ didAlloc = 1;
for (index = 0; index < numObjStrings; index++) {
Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
- attributeStringsAllocated[index] = TclGetString(objPtr);
+ attributeStrings[index] = TclGetString(objPtr);
}
- attributeStringsAllocated[index] = NULL;
- attributeStrings = attributeStringsAllocated;
+ attributeStrings[index] = NULL;
} else if (objStrings != NULL) {
Tcl_Panic("must not update objPtrRef's variable and return non-NULL");
}
- /*
- * Process the attributes to produce a list of all of them, the value of a
- * particular attribute, or to set one or more attributes (depending on
- * the number of arguments).
- */
-
if (objc == 0) {
/*
* Get all attributes.
@@ -1059,7 +1049,7 @@ TclFileAttrsCmd(
goto end;
}
- Tcl_SetObjResult(interp, listPtr);
+ Tcl_SetObjResult(interp, listPtr);
} else if (objc == 1) {
/*
* Get one attribute.
@@ -1072,7 +1062,6 @@ TclFileAttrsCmd(
Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
"\", there are no file attributes in this filesystem.",
NULL);
- Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
@@ -1080,8 +1069,9 @@ TclFileAttrsCmd(
"option", 0, &index) != TCL_OK) {
goto end;
}
- if (attributeStringsAllocated != NULL) {
+ if (didAlloc) {
TclFreeIntRep(objv[0]);
+ objv[0]->typePtr = NULL;
}
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
&objPtr) != TCL_OK) {
@@ -1099,406 +1089,48 @@ TclFileAttrsCmd(
Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
"\", there are no file attributes in this filesystem.",
NULL);
- Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
goto end;
}
- for (i = 0; i < objc ; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
+ for (i = 0; i < objc ; i += 2) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
"option", 0, &index) != TCL_OK) {
goto end;
- }
- if (attributeStringsAllocated != NULL) {
+ }
+ if (didAlloc) {
TclFreeIntRep(objv[i]);
+ objv[i]->typePtr = NULL;
}
if (i + 1 == objc) {
Tcl_AppendResult(interp, "value for \"",
TclGetString(objv[i]), "\" missing", NULL);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
- "NOVALUE", NULL);
goto end;
}
- if (Tcl_FSFileAttrsSet(interp, index, filePtr,
- objv[i + 1]) != TCL_OK) {
+ if (Tcl_FSFileAttrsSet(interp, index, filePtr,
+ objv[i + 1]) != TCL_OK) {
goto end;
- }
- }
+ }
+ }
}
result = TCL_OK;
- /*
- * Free up the array we allocated and drop our reference to any list of
- * attribute names issued by the filesystem.
- */
-
end:
- if (attributeStringsAllocated != NULL) {
- TclStackFree(interp, (void *) attributeStringsAllocated);
- }
- if (objStrings != NULL) {
- Tcl_DecrRefCount(objStrings);
- }
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFileLinkCmd --
- *
- * This function is invoked to process the "file link" Tcl command. See
- * the user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * May create a new link.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclFileLinkCmd(
- ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- Tcl_Obj *contents;
- int index;
-
- if (objc < 2 || objc > 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
- return TCL_ERROR;
- }
-
- /*
- * Index of the 'source' argument.
- */
-
- if (objc == 4) {
- index = 2;
- } else {
- index = 1;
- }
-
- if (objc > 2) {
- int linkAction;
-
- if (objc == 4) {
- /*
- * We have a '-linktype' argument.
- */
-
- static const char *const linkTypes[] = {
- "-symbolic", "-hard", NULL
- };
- if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "switch", 0,
- &linkAction) != TCL_OK) {
- return TCL_ERROR;
- }
- if (linkAction == 0) {
- linkAction = TCL_CREATE_SYMBOLIC_LINK;
- } else {
- linkAction = TCL_CREATE_HARD_LINK;
- }
- } else {
- linkAction = TCL_CREATE_SYMBOLIC_LINK | TCL_CREATE_HARD_LINK;
- }
- if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /*
- * Create link from source to target.
- */
-
- contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
- if (contents == NULL) {
- /*
- * We handle three common error cases specially, and for all other
- * errors, we use the standard posix error message.
- */
-
- if (errno == EEXIST) {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]),
- "\": that path already exists", NULL);
- Tcl_PosixError(interp);
- } else if (errno == ENOENT) {
- /*
- * There are two cases here: either the target doesn't exist,
- * or the directory of the src doesn't exist.
- */
-
- int access;
- Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
- TCL_PATH_DIRNAME);
-
- if (dirPtr == NULL) {
- return TCL_ERROR;
- }
- access = Tcl_FSAccess(dirPtr, F_OK);
- Tcl_DecrRefCount(dirPtr);
- if (access != 0) {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]),
- "\": no such file or directory", NULL);
- Tcl_PosixError(interp);
- } else {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]), "\": target \"",
- TclGetString(objv[index+1]), "\" doesn't exist",
- NULL);
- errno = ENOENT;
- Tcl_PosixError(interp);
- }
- } else {
- Tcl_AppendResult(interp, "could not create new link \"",
- TclGetString(objv[index]), "\" pointing to \"",
- TclGetString(objv[index+1]), "\": ",
- Tcl_PosixError(interp), NULL);
- }
- return TCL_ERROR;
- }
- } else {
- if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /*
- * Read link
- */
-
- contents = Tcl_FSLink(objv[index], NULL, 0);
- if (contents == NULL) {
- Tcl_AppendResult(interp, "could not read link \"",
- TclGetString(objv[index]), "\": ", Tcl_PosixError(interp),
- NULL);
- return TCL_ERROR;
- }
- }
- Tcl_SetObjResult(interp, contents);
- if (objc == 2) {
+ if (didAlloc) {
/*
- * If we are reading a link, we need to free this result refCount. If
- * we are creating a link, this will just be objv[index+1], and so we
- * don't own it.
+ * Free up the array we allocated.
*/
- Tcl_DecrRefCount(contents);
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFileReadLinkCmd --
- *
- * This function is invoked to process the "file readlink" Tcl command.
- * See the user documentation for details on what it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclFileReadLinkCmd(
- ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- Tcl_Obj *contents;
-
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "name");
- return TCL_ERROR;
- }
-
- if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
- return TCL_ERROR;
- }
-
- contents = Tcl_FSLink(objv[1], NULL, 0);
-
- if (contents == NULL) {
- Tcl_AppendResult(interp, "could not readlink \"",
- TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL);
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, contents);
- Tcl_DecrRefCount(contents);
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFileTemporaryCmd
- *
- * This function implements the "tempfile" subcommand of the "file"
- * command.
- *
- * Results:
- * Returns a standard Tcl result.
- *
- * Side effects:
- * Creates a temporary file. Opens a channel to that file and puts the
- * name of that channel in the result. *Might* register suitable exit
- * handlers to ensure that the temporary file gets deleted. Might write
- * to a variable, so reentrancy is a potential issue.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclFileTemporaryCmd(
- ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary
- * file in. */
- Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */
- Tcl_Channel chan; /* The channel opened (RDWR) on the temporary
- * file, or NULL if there's an error. */
- Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
- /* Pieces of template. Each piece is NULL if
- * it is omitted. The platform temporary file
- * engine might ignore some pieces. */
-
- if (objc < 1 || objc > 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?");
- return TCL_ERROR;
- }
-
- if (objc > 1) {
- nameVarObj = objv[1];
- TclNewObj(nameObj);
+ TclStackFree(interp, (void *)attributeStrings);
}
- if (objc > 2) {
- int length;
- Tcl_Obj *templateObj = objv[2];
- const char *string = TclGetStringFromObj(templateObj, &length);
-
- /*
- * Treat an empty string as if it wasn't there.
- */
-
- if (length == 0) {
- goto makeTemporary;
- }
-
- /*
- * The template only gives a directory if there is a directory
- * separator in it.
- */
-
- if (strchr(string, '/') != NULL
- || (tclPlatform == TCL_PLATFORM_WINDOWS
- && strchr(string, '\\') != NULL)) {
- tempDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
-
- /*
- * Only allow creation of temporary files in the native filesystem
- * since they are frequently used for integration with external
- * tools or system libraries. [Bug 2388866]
- */
-
- if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj)
- != &tclNativeFilesystem) {
- TclDecrRefCount(tempDirObj);
- tempDirObj = NULL;
- }
- }
+ if (objStrings != NULL) {
/*
- * The template only gives the filename if the last character isn't a
- * directory separator.
+ * We don't need this object that was passed to us any more.
*/
- if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
- || string[length-1] != '\\')) {
- Tcl_Obj *tailObj = TclPathPart(interp, templateObj,
- TCL_PATH_TAIL);
-
- if (tailObj != NULL) {
- tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
- tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
- TclDecrRefCount(tailObj);
- }
- }
- }
-
- /*
- * Convert empty parts of the template into unspecified parts.
- */
-
- if (tempDirObj && !TclGetString(tempDirObj)[0]) {
- TclDecrRefCount(tempDirObj);
- tempDirObj = NULL;
- }
- if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
- TclDecrRefCount(tempBaseObj);
- tempBaseObj = NULL;
- }
- if (tempExtObj && !TclGetString(tempExtObj)[0]) {
- TclDecrRefCount(tempExtObj);
- tempExtObj = NULL;
- }
-
- /*
- * Create and open the temporary file.
- */
-
- makeTemporary:
- chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
-
- /*
- * If we created pieces of template, get rid of them now.
- */
-
- if (tempDirObj) {
- TclDecrRefCount(tempDirObj);
- }
- if (tempBaseObj) {
- TclDecrRefCount(tempBaseObj);
- }
- if (tempExtObj) {
- TclDecrRefCount(tempExtObj);
- }
-
- /*
- * Deal with results.
- */
-
- if (chan == NULL) {
- if (nameVarObj) {
- TclDecrRefCount(nameObj);
- }
- Tcl_AppendResult(interp, "can't create temporary file: ",
- Tcl_PosixError(interp), NULL);
- return TCL_ERROR;
- }
- Tcl_RegisterChannel(interp, chan);
- if (nameVarObj != NULL) {
- if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- Tcl_UnregisterChannel(interp, chan);
- return TCL_ERROR;
- }
+ Tcl_DecrRefCount(objStrings);
}
- Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
- return TCL_OK;
+ return result;
}
/*
generated by cgit v0.12 at 2025-12-20 21:32:41 (GMT)