From dad41b847302dce4ebd5139c0568aad2ad7a0776 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 15 Sep 2005 16:40:02 +0000 Subject: * 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 --- ChangeLog | 17 ++++++++- generic/tclBasic.c | 7 ++-- generic/tclCkalloc.c | 7 ++-- generic/tclCmdMZ.c | 6 ++- generic/tclExecute.c | 5 ++- generic/tclIORChan.c | 10 +++-- generic/tclMain.c | 17 +++++---- generic/tclProc.c | 39 ++++++++++--------- generic/tclTimer.c | 13 ++++--- generic/tclUtil.c | 24 ++++++------ unix/configure | 104 +++++++++++++++++++++++++++++++++++++++++++++++++++ unix/tclUnixFCmd.c | 9 ++--- 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 + + * 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 * 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 +2005-09-14 Don Porter * 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 @@ -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 +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 +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; } -- cgit v0.12