summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-09-15 16:40:02 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-09-15 16:40:02 (GMT)
commitdad41b847302dce4ebd5139c0568aad2ad7a0776 (patch)
tree238980bfb093b32ba311f36a2774bde6bba0c4ee
parent75aee26af34aeea93c32910c88c0d5cef7077ff7 (diff)
downloadtcl-dad41b847302dce4ebd5139c0568aad2ad7a0776.zip
tcl-dad41b847302dce4ebd5139c0568aad2ad7a0776.tar.gz
tcl-dad41b847302dce4ebd5139c0568aad2ad7a0776.tar.bz2
* generic/tclBasic.c: More callers of TclObjPrintf and
* generic/tclCkalloc.c: TclFormatToErrorInfo. * generic/tclCmdMZ.c: * generic/tclExecute.c: * generic/tclIORChan.c: * generic/tclMain.c: * generic/tclProc.c: * generic/tclTimer.c: * generic/tclUtil.c: * unix/tclUnixFCmd.c * unix/configure: autoconf-2.59
-rw-r--r--ChangeLog17
-rw-r--r--generic/tclBasic.c7
-rw-r--r--generic/tclCkalloc.c7
-rw-r--r--generic/tclCmdMZ.c6
-rw-r--r--generic/tclExecute.c5
-rw-r--r--generic/tclIORChan.c10
-rw-r--r--generic/tclMain.c17
-rw-r--r--generic/tclProc.c39
-rw-r--r--generic/tclTimer.c13
-rw-r--r--generic/tclUtil.c24
-rwxr-xr-xunix/configure104
-rw-r--r--unix/tclUnixFCmd.c9
12 files changed, 194 insertions, 64 deletions
diff --git a/ChangeLog b/ChangeLog
index 9bcf67c..de3c6bf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,9 +1,24 @@
+2005-09-15 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: More callers of TclObjPrintf and
+ * generic/tclCkalloc.c: TclFormatToErrorInfo.
+ * generic/tclCmdMZ.c:
+ * generic/tclExecute.c:
+ * generic/tclIORChan.c:
+ * generic/tclMain.c:
+ * generic/tclProc.c:
+ * generic/tclTimer.c:
+ * generic/tclUtil.c:
+ * unix/tclUnixFCmd.c
+
+ * unix/configure: autoconf-2.59
+
2005-09-15 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* unix/tcl.m4 (SC_TCL_EARLY_FLAGS): Added extra hack to allow Tcl
to transparently open large files on RHEL 3. [Bug 1287638]
-2005-09-13 Don Porter <dgp@users.sourceforge.net>
+2005-09-14 Don Porter <dgp@users.sourceforge.net>
* generic/tclStringObj.c: Bug fixes: ObjPrintfVA needed to
support "*" fields and needed to interpret precision limits on
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a58c781..0198a4e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.173 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.174 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -4156,8 +4156,9 @@ ProcessUnexpectedResult(interp, returnCode)
Tcl_AppendResult(interp,
"invoked \"continue\" outside of a loop", (char *) NULL);
} else {
- TclObjPrintf(NULL, Tcl_GetObjResult(interp),
- "command returned bad code: %d", returnCode);
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr, "command returned bad code: %d", returnCode);
+ Tcl_SetObjResult(interp, objPtr);
}
}
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 43e0862..e3eea4e 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -14,7 +14,7 @@
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
*
- * RCS: @(#) $Id: tclCkalloc.c,v 1.24 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.25 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -843,13 +843,14 @@ MemoryCmd(clientData, interp, argc, argv)
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
- TclObjPrintf(NULL, Tcl_GetObjResult(interp),
- "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
"total mallocs", total_mallocs, "total frees", total_frees,
"current packets allocated", current_malloc_packets,
"current bytes allocated", current_bytes_malloced,
"maximum packets allocated", maximum_malloc_packets,
"maximum bytes allocated", maximum_bytes_malloced);
+ Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
if (strcmp(argv[1],"init") == 0) {
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index ebc27f6..b4a7d5a 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.130 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.131 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -2158,9 +2158,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
length2 = length1 * count;
if ((length2 / count) != length1) {
- TclObjPrintf(NULL, Tcl_GetObjResult(interp),
+ resultPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, resultPtr,
"string size overflow, must be less than %d",
INT_MAX);
+ Tcl_SetObjResult(interp, resultPtr);
return TCL_ERROR;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 52556fd..c7502f0 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.200 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.201 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -6094,11 +6094,12 @@ TclExprFloatError(interp, value)
Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
}
} else {
- Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
+ Tcl_Obj *objPtr = Tcl_NewObj();
TclObjPrintf(NULL, objPtr,
"unknown floating-point error, errno = %d", errno);
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
Tcl_GetString(objPtr), (char *) NULL);
+ Tcl_SetObjResult(interp, objPtr);
}
}
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 13b8028..0a57eb3 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIORChan.c,v 1.4 2005/09/14 21:32:17 dgp Exp $
+ * RCS: @(#) $Id: tclIORChan.c,v 1.5 2005/09/15 16:40:02 dgp Exp $
*/
#include <tclInt.h>
@@ -1723,10 +1723,12 @@ RcGetOption (clientData, interp, optionName, dsPtr)
if ((listc % 2) == 1) {
/* Odd number of elements is wrong.
*/
+ Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_ResetResult(interp);
- TclObjPrintf(NULL, Tcl_GetObjResult(interp),
- "Expected list with even number of elements, got %d element%s instead",
- listc, (listc == 1 ? "" : "s"));
+ TclObjPrintf(NULL, objPtr, "Expected list with even number of "
+ "elements, got %d element%s instead", listc,
+ (listc == 1 ? "" : "s"));
+ Tcl_SetObjResult(interp, objPtr);
Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
return TCL_ERROR;
}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index f2954b6..75fa70b 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMain.c,v 1.31 2005/07/21 14:38:49 dkf Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.32 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -655,20 +655,21 @@ Tcl_Main(argc, argv, appInitProc)
/*
* Rather than calling exit, invoke the "exit" command so that users can
* replace "exit" with some other command to do additional cleanup on
- * exit. The Tcl_Eval call should never return.
+ * exit. The Tcl_EvalObjEx call should never return.
*/
if (!Tcl_InterpDeleted(interp)) {
if (!Tcl_LimitExceeded(interp)) {
- char buffer[TCL_INTEGER_SPACE + 5];
-
- sprintf(buffer, "exit %d", exitCode);
- Tcl_Eval(interp, buffer);
+ Tcl_Obj *cmd = Tcl_NewObj();
+ TclObjPrintf(NULL, cmd, "exit %d", exitCode);
+ Tcl_IncrRefCount(cmd);
+ Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(cmd);
}
/*
- * If Tcl_Eval returns, trying to eval [exit], something unusual is
- * happening. Maybe interp has been deleted; maybe [exit] was
+ * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
+ * is happening. Maybe interp has been deleted; maybe [exit] was
* redefined, maybe we've blown up because of an exceeded limit. We
* still want to cleanup and exit.
*/
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 3a962d2..b184c8a 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.79 2005/09/14 18:35:56 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.80 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -337,11 +337,12 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
if (precompiled) {
if (numArgs > procPtr->numArgs) {
- char buf[40 + TCL_INTEGER_SPACE + TCL_INTEGER_SPACE];
- sprintf(buf, "%d entries, precompiled header expects %d",
- numArgs, procPtr->numArgs);
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\": arg list contains ", buf, NULL);
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr,
+ "procedure \"%s\": arg list contains %d entries, "
+ "precompiled header expects %d", procName, numArgs,
+ procPtr->numArgs);
+ Tcl_SetObjResult(interp, objPtr);
goto procError;
}
localPtr = procPtr->firstLocalPtr;
@@ -428,12 +429,12 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
!= (VAR_SCALAR | VAR_ARGUMENT))
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|| (localPtr->defValuePtr != NULL && fieldCount != 2)) {
- char buf[40 + TCL_INTEGER_SPACE];
-
+ Tcl_Obj *objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr,
+ "procedure \"%s\": formal parameter %d is "
+ "inconsistent with precompiled body", procName, i);
+ Tcl_SetObjResult(interp, objPtr);
ckfree((char *) fieldValues);
- sprintf(buf, "%d is inconsistent with precompiled body", i);
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\": formal parameter ", buf, (char *) NULL);
goto procError;
}
@@ -447,10 +448,13 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
&tmpLength);
if ((valueLength != tmpLength) ||
strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
- Tcl_AppendResult(interp, "procedure \"", procName,
- "\": formal parameter \"", fieldValues[0],
- "\" has default value inconsistent with ",
- "precompiled body", (char *) NULL);
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ TclObjPrintf(NULL, objPtr,
+ "procedure \"%s\": formal parameter \"%s\" has "
+ "default value inconsistent with precompiled body",
+ procName, fieldValues[0]);
+ Tcl_SetObjResult(interp, objPtr);
ckfree((char *) fieldValues);
goto procError;
}
@@ -810,9 +814,8 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
if (result == TCL_ERROR) {
- char msg[32 + TCL_INTEGER_SPACE];
- sprintf(msg, "\n (\"uplevel\" body line %d)", interp->errorLine);
- Tcl_AddObjErrorInfo(interp, msg, -1);
+ TclFormatToErrorInfo(interp, "\n (\"uplevel\" body line %d)",
+ interp->errorLine);
}
/*
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index ce07825..e441867 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTimer.c,v 1.17 2005/07/24 22:56:44 dkf Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.18 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -781,6 +781,7 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
static CONST char *afterSubCmds[] = {
"cancel", "idle", "info", (char *) NULL
};
+ Tcl_Obj *objPtr;
enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
ThreadSpecificData *tsdPtr = InitTimer();
@@ -848,8 +849,9 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
(ClientData) afterPtr);
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
- sprintf(buf, "after#%d", afterPtr->id);
- Tcl_AppendResult(interp, buf, (char *) NULL);
+ objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
+ Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
@@ -926,8 +928,9 @@ Tcl_AfterObjCmd(clientData, interp, objc, objv)
afterPtr->nextPtr = assocPtr->firstAfterPtr;
assocPtr->firstAfterPtr = afterPtr;
Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
- sprintf(buf, "after#%d", afterPtr->id);
- Tcl_AppendResult(interp, buf, (char *) NULL);
+ objPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
+ Tcl_SetObjResult(interp, objPtr);
break;
case AFTER_INFO: {
Tcl_Obj *resultListPtr;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 0654f65..1dd6fcb 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUtil.c,v 1.64 2005/09/06 14:40:11 dkf Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.65 2005/09/15 16:40:02 dgp Exp $
*/
#include "tclInt.h"
@@ -235,18 +235,17 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
if (interp != NULL) {
- char buf[100];
-
+ Tcl_Obj *objPtr = Tcl_NewObj();
p2 = p;
while ((p2 < limit)
&& (!isspace(UCHAR(*p2))) /* INTL: ISO space. */
&& (p2 < p+20)) {
p2++;
}
- sprintf(buf,
- "list element in braces followed by \"%.*s\" instead of space",
- (int) (p2-p), p);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ TclObjPrintf(NULL, objPtr,
+ "list element in braces followed by \"%.*s\" "
+ "instead of space", (int) (p2-p), p);
+ Tcl_SetObjResult(interp, objPtr);
}
return TCL_ERROR;
}
@@ -297,18 +296,17 @@ TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr,
*/
if (interp != NULL) {
- char buf[100];
-
+ Tcl_Obj *objPtr = Tcl_NewObj();
p2 = p;
while ((p2 < limit)
&& (!isspace(UCHAR(*p2))) /* INTL: ISO space */
&& (p2 < p+20)) {
p2++;
}
- sprintf(buf,
- "list element in quotes followed by \"%.*s\" %s",
- (int) (p2-p), p, "instead of space");
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ TclObjPrintf(NULL, objPtr,
+ "list element in quotes followed by \"%.*s\" "
+ "instead of space", (int) (p2-p), p);
+ Tcl_SetObjResult(interp, objPtr);
}
return TCL_ERROR;
}
diff --git a/unix/configure b/unix/configure
index 47cbd41..016f053 100755
--- a/unix/configure
+++ b/unix/configure
@@ -8952,6 +8952,110 @@ _ACEOF
tcl_flags="$tcl_flags _LARGEFILE64_SOURCE"
fi
+
+ if test "${tcl_cv_flag__largefile_source64+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <sys/stat.h>
+int
+main ()
+{
+char *p = (char *)open64;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_flag__largefile_source64=no
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#define _LARGEFILE_SOURCE64 1
+#include <sys/stat.h>
+int
+main ()
+{
+char *p = (char *)open64;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ tcl_cv_flag__largefile_source64=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+tcl_cv_flag__largefile_source64=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+
+ if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then
+
+cat >>confdefs.h <<\_ACEOF
+#define _LARGEFILE_SOURCE64 1
+_ACEOF
+
+ tcl_flags="$tcl_flags _LARGEFILE_SOURCE64"
+ fi
if test "x${tcl_flags}" = "x" ; then
echo "$as_me:$LINENO: result: none" >&5
echo "${ECHO_T}none" >&6
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 2e74592..4105544 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixFCmd.c,v 1.44 2005/07/20 23:16:00 dkf Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.45 2005/09/15 16:40:03 dgp Exp $
*
* Portions of this code were derived from NetBSD source code which has the
* following copyright notice:
@@ -1286,7 +1286,6 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
{
Tcl_StatBuf statBuf;
- char returnString[7];
int result;
result = TclpObjStat(fileName, &statBuf);
@@ -1300,9 +1299,9 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
return TCL_ERROR;
}
- sprintf(returnString, "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF));
-
- *attributePtrPtr = Tcl_NewStringObj(returnString, -1);
+ *attributePtrPtr = Tcl_NewObj();
+ TclObjPrintf(NULL, *attributePtrPtr, "%0#5lo",
+ (long) (statBuf.st_mode & 0x00007FFF));
return TCL_OK;
}