diff --git a/configure b/configure index 824b4bcd..b8ef896c 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for tclx 8.6. +# Generated by GNU Autoconf 2.69 for tclx 9.0. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. @@ -577,8 +577,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='tclx' PACKAGE_TARNAME='tclx' -PACKAGE_VERSION='8.6' -PACKAGE_STRING='tclx 8.6' +PACKAGE_VERSION='9.0' +PACKAGE_STRING='tclx 9.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1298,7 +1298,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tclx 8.6 to adapt to many kinds of systems. +\`configure' configures tclx 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1359,7 +1359,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tclx 8.6:";; + short | recursive ) echo "Configuration of tclx 9.0:";; esac cat <<\_ACEOF @@ -1460,7 +1460,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -tclx configure 8.6 +tclx configure 9.0 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -1982,7 +1982,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tclx $as_me 8.6, which was +It was created by tclx $as_me 9.0, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -2330,7 +2330,7 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -FULL_VERSION="8.6.0" +FULL_VERSION="9.0.0" # TEA extensions pass this us the version of TEA they think they @@ -2598,7 +2598,7 @@ $as_echo "$as_me: WARNING: --with-tcl argument should refer to directory contain `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ - `ls -d /usr/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/lib/tcl9.0 2>/dev/null` \ `ls -d /usr/lib/tcl8.5 2>/dev/null` \ ; do if test -f "$i/tclConfig.sh" ; then @@ -10398,7 +10398,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by tclx $as_me 8.6, which was +This file was extended by tclx $as_me 9.0, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -10451,7 +10451,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -tclx config.status 8.6 +tclx config.status 9.0 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/configure.in b/configure.in index 20ee0214..f1a3392a 100755 --- a/configure.in +++ b/configure.in @@ -5,8 +5,8 @@ dnl to configure the system for the local environment. # # RCS: @(#) $Id: configure.in,v 1.17 2006/01/26 00:30:54 hobbs Exp $ -AC_INIT([tclx], [8.6]) -FULL_VERSION="8.6.0" +AC_INIT([tclx], [9.0]) +FULL_VERSION="9.0.0" TEA_INIT([3.9]) diff --git a/generic/tclExtend.h b/generic/tclExtend.h index 7ac360d8..fbd0374a 100644 --- a/generic/tclExtend.h +++ b/generic/tclExtend.h @@ -52,6 +52,10 @@ typedef void *void_pt; #define TCLX_CMDL_INTERACTIVE (1<<0) #define TCLX_CMDL_EXIT_ON_EOF (1<<1) +#define CONST const +#define VOID void +#define panic Tcl_Panic + /* * Application signal error handler. Called after normal signal processing, * when a signal results in an error. Its main purpose in life is to allow @@ -97,7 +101,7 @@ EXTERN void TclX_SplitWinCmdLine (int *argcPtr, char ***argvPtr); /* * Exported utility functions. */ -EXTERN void TclX_AppendObjResult TCL_VARARGS_DEF(Tcl_Interp *, interpArg); +EXTERN void TclX_AppendObjResult (Tcl_Interp *, ...); EXTERN char * TclX_DownShift (char *targetStr, CONST char *sourceStr); diff --git a/generic/tclXbsearch.c b/generic/tclXbsearch.c index a2dc37b7..19e43019 100644 --- a/generic/tclXbsearch.c +++ b/generic/tclXbsearch.c @@ -168,7 +168,7 @@ ReadAndCompare (off_t fileOffset, binSearchCB_t *searchCBPtr) * one. */ if (fileOffset != 0) { - if (Tcl_Gets (searchCBPtr->channel, &searchCBPtr->lineBuf) < 0) { + if (Tcl_Gets (searchCBPtr->channel, &searchCBPtr->lineBuf) <= 0) { if (Tcl_Eof (searchCBPtr->channel) || Tcl_InputBlocked (searchCBPtr->channel)) { TclX_AppendObjResult (searchCBPtr->interp, @@ -197,7 +197,7 @@ ReadAndCompare (off_t fileOffset, binSearchCB_t *searchCBPtr) * Read the line. Only compare if EOF was not hit, otherwise, treat as if * we went above the key we are looking for. */ - if (Tcl_Gets (searchCBPtr->channel, &searchCBPtr->lineBuf) < 0) { + if (Tcl_Gets (searchCBPtr->channel, &searchCBPtr->lineBuf) <= 0) { if (Tcl_Eof (searchCBPtr->channel) || Tcl_InputBlocked (searchCBPtr->channel)) { searchCBPtr->cmpResult = -1; @@ -343,7 +343,7 @@ TclX_BsearchObjCmd (ClientData clientData, valPtr = Tcl_NewStringObj (Tcl_DStringValue (&searchCB.lineBuf), -1); if (Tcl_ObjSetVar2(interp, objv[3], NULL, valPtr, - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) == NULL) { + TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount (valPtr); goto errorExit; } diff --git a/generic/tclXchmod.c b/generic/tclXchmod.c index 65f05361..c7a2c5dd 100644 --- a/generic/tclXchmod.c +++ b/generic/tclXchmod.c @@ -313,7 +313,6 @@ TclX_ChmodObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * Tcl_Obj **fileObjv; char *fileIdsString; char *modeString; - int modeBits; /* * Options are not parsable just looking for "-", since modes can @@ -334,12 +333,10 @@ TclX_ChmodObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * modeString = Tcl_GetStringFromObj (objv [objIdx], NULL); if (ISDIGIT (modeString[0])) { - if (Tcl_GetIntFromObj (interp, objv [objIdx], &modeBits) - != TCL_OK) - return TCL_ERROR; - modeInfo.absMode = modeBits; + modeInfo.absMode = strtol(modeString, 0, 0); modeInfo.symMode = NULL; } else { + modeInfo.absMode = 0; modeInfo.symMode = modeString; } diff --git a/generic/tclXdup.c b/generic/tclXdup.c index 7e83fdaa..115e82ee 100644 --- a/generic/tclXdup.c +++ b/generic/tclXdup.c @@ -75,7 +75,7 @@ DupChannelOptions (Tcl_Interp *interp, goto errorExit; } if ((optArgc % 2) != 0) { - panic("channel didn't return keyword/value pairs"); + Tcl_Panic("channel didn't return keyword/value pairs"); } for (idx = 0; idx < optArgc; idx += 2) { @@ -208,18 +208,11 @@ TclX_DupObjCmd (ClientData clientData, * If a number is supplied, bind it to a file handle rather than doing * a dup. */ - if (objv [1]->typePtr == Tcl_GetObjType ("int")) { - bindFnum = TRUE; - } else { - srcChannelId = Tcl_GetStringFromObj (objv [1], NULL); - if (ISDIGIT (srcChannelId [0])) { - if (Tcl_ConvertToType (interp, objv [1], - Tcl_GetObjType ("int")) != TCL_OK) - goto badFnum; + + bindFnum = FALSE; + srcChannelId = Tcl_GetStringFromObj (objv [1], NULL); + if (ISDIGIT (srcChannelId [0])) { bindFnum = TRUE; - } else { - bindFnum = FALSE; - } } if (bindFnum) { if (objc != 2) @@ -245,14 +238,6 @@ TclX_DupObjCmd (ClientData clientData, Tcl_GetChannelName (newChannel), -1); return TCL_OK; - badFnum: - Tcl_ResetResult (interp); - TclX_AppendObjResult (interp, "invalid integer file number \"", - Tcl_GetStringFromObj (objv [1], NULL), - "\", expected unsigned integer or Tcl file id", - (char *) NULL); - return TCL_ERROR; - bind2ndArg: TclX_AppendObjResult (interp, "the second argument, targetChannelId, ", "is not allow when binding a file number to ", diff --git a/generic/tclXfcntl.c b/generic/tclXfcntl.c index 070caa31..20e810bd 100644 --- a/generic/tclXfcntl.c +++ b/generic/tclXfcntl.c @@ -200,11 +200,11 @@ GetFcntlAttr (Tcl_Interp *interp, Tcl_Channel channel, int mode, int attrib) value = (optValue == TCLX_BUFFERING_LINE); break; case ATTR_KEEPALIVE: - if (TclXOSgetsockopt (interp, channel, SO_KEEPALIVE, &value) != TCL_OK) + if (TclXOSgetsockopt (interp, channel, SO_KEEPALIVE, (socklen_t *) &value) != TCL_OK) return TCL_ERROR; break; default: - panic ("bug in fcntl get attrib"); + Tcl_Panic ("bug in fcntl get attrib"); value = 0; /* suppress compiler warning for initialized value */ } @@ -260,7 +260,7 @@ SetFcntlAttrObj (Tcl_Interp *interp, case ATTR_KEEPALIVE: return TclXOSsetsockopt (interp, channel, SO_KEEPALIVE, value); default: - panic ("buf in fcntl set attrib"); + Tcl_Panic ("buf in fcntl set attrib"); } return TCL_ERROR; /* Should never be reached */ } diff --git a/generic/tclXfilecmds.c b/generic/tclXfilecmds.c index ae2ca2b8..366d1d51 100644 --- a/generic/tclXfilecmds.c +++ b/generic/tclXfilecmds.c @@ -87,12 +87,12 @@ TclX_PipeObjCmd (ClientData clientData, channelNames [1], (char *) NULL); } else { if (Tcl_ObjSetVar2(interp, objv[1], NULL, Tcl_NewStringObj(channelNames [0], -1), - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) == NULL) + TCL_LEAVE_ERR_MSG) == NULL) goto errorExit; if (Tcl_ObjSetVar2(interp, objv[2], NULL, Tcl_NewStringObj(channelNames [1], -1), - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) == NULL) + TCL_LEAVE_ERR_MSG) == NULL) goto errorExit; } diff --git a/generic/tclXfilescan.c b/generic/tclXfilescan.c index 77358f6d..31c3e184 100644 --- a/generic/tclXfilescan.c +++ b/generic/tclXfilescan.c @@ -641,12 +641,7 @@ ScanFile (Tcl_Interp *interp, scanContext_t *contextPtr, Tcl_Channel channel) data.offset = (off_t) Tcl_Tell (channel); Tcl_DStringSetLength (&lineBuf, 0); - if (Tcl_Gets (channel, &lineBuf) < 0) { - if (Tcl_Eof (channel) || Tcl_InputBlocked (channel)) - goto scanExit; - Tcl_SetStringObj (Tcl_GetObjResult (interp), - Tcl_PosixError (interp), -1); - result = TCL_ERROR; + if (Tcl_Gets (channel, &lineBuf) < 0 || Tcl_Eof (channel) || Tcl_InputBlocked (channel) ) { goto scanExit; } diff --git a/generic/tclXgeneral.c b/generic/tclXgeneral.c index 204619e4..a00e276b 100644 --- a/generic/tclXgeneral.c +++ b/generic/tclXgeneral.c @@ -321,7 +321,7 @@ SetLoopCounter (Tcl_Interp *interp, char *varName, int idx) { Tcl_Obj *iObj, *newVarObj; - iObj = Tcl_GetVar2Ex(interp, varName, NULL, TCL_PARSE_PART1); + iObj = Tcl_GetVar2Ex(interp, varName, NULL, 0); if ((iObj == NULL) || (Tcl_IsShared (iObj))) { iObj = newVarObj = Tcl_NewLongObj (idx); } else { @@ -330,7 +330,7 @@ SetLoopCounter (Tcl_Interp *interp, char *varName, int idx) Tcl_SetLongObj (iObj, idx); if (Tcl_SetVar2Ex(interp, varName, NULL, iObj, - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) == NULL) { + TCL_LEAVE_ERR_MSG) == NULL) { if (newVarObj != NULL) { Tcl_DecrRefCount (newVarObj); } diff --git a/generic/tclXhandles.c b/generic/tclXhandles.c index 97c09ff9..ae2f21a0 100644 --- a/generic/tclXhandles.c +++ b/generic/tclXhandles.c @@ -539,7 +539,7 @@ TclX_HandleFree (void_pt headerPtr, void_pt entryPtr) entryHdrPtr = HEADER_AREA (entryPtr); if (entryHdrPtr->freeLink != ALLOCATED_IDX) - panic ("Tcl_HandleFree: entry not allocated %x\n", entryHdrPtr); + Tcl_Panic ("Tcl_HandleFree: entry not allocated %x\n", entryHdrPtr->freeLink); entryHdrPtr->freeLink = tblHdrPtr->freeHeadIdx; tblHdrPtr->freeHeadIdx = diff --git a/generic/tclXkeylist.c b/generic/tclXkeylist.c index 3a6f8f20..1e846337 100644 --- a/generic/tclXkeylist.c +++ b/generic/tclXkeylist.c @@ -338,7 +338,7 @@ DeleteKeyedListEntry (keylIntObj_t *keylIntPtr, int entryIdx) if (keylIntPtr->hashTbl != NULL) { Tcl_HashEntry *entryPtr; Tcl_HashSearch search; - int nidx; + uintptr_t nidx; entryPtr = Tcl_FindHashEntry(keylIntPtr->hashTbl, keylIntPtr->entries [entryIdx].key); @@ -354,7 +354,7 @@ DeleteKeyedListEntry (keylIntObj_t *keylIntPtr, int entryIdx) */ for (entryPtr = Tcl_FirstHashEntry(keylIntPtr->hashTbl, &search); entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) { - nidx = (int) Tcl_GetHashValue(entryPtr); + nidx = (uintptr_t) Tcl_GetHashValue(entryPtr); if (nidx > entryIdx) { Tcl_SetHashValue(entryPtr, (ClientData) (uintptr_t) (nidx - 1)); } @@ -394,7 +394,7 @@ FindKeyedListEntry (keylIntObj_t *keylIntPtr, char **nextSubKeyPtr) { char *keySeparPtr; - int keyLen, findIdx = -1; + uintptr_t keyLen, findIdx = -1; keySeparPtr = strchr (key, '.'); if (keySeparPtr != NULL) { @@ -416,7 +416,7 @@ FindKeyedListEntry (keylIntObj_t *keylIntPtr, } entryPtr = Tcl_FindHashEntry(keylIntPtr->hashTbl, key); if (entryPtr != NULL) { - findIdx = (int) Tcl_GetHashValue(entryPtr); + findIdx = (uintptr_t) Tcl_GetHashValue(entryPtr); } if (keySeparPtr != NULL) { key[keyLen] = tmp; diff --git a/generic/tclXlgets.c b/generic/tclXlgets.c index 4ce6bba6..caf7ea0d 100644 --- a/generic/tclXlgets.c +++ b/generic/tclXlgets.c @@ -282,8 +282,7 @@ ReadListElement (Tcl_Interp *interp, case '\\': { char bsChar; - - bsChar = Tcl_Backslash(p, &numChars); + Tcl_UtfBackslash(p, &numChars, &bsChar); if (openBraces > 0) { p += (numChars - 1); /* Advanced again at end of loop */ } else { @@ -470,7 +469,7 @@ TclX_LgetsObjCmd (ClientData clientData, int resultLen; if (Tcl_ObjSetVar2(interp, objv[2], NULL, dataObj, - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) == NULL) { + TCL_LEAVE_ERR_MSG) == NULL) { goto errorExit; } @@ -512,7 +511,7 @@ TclX_LgetsObjCmd (ClientData clientData, * FIX: Need functions to save/restore error state. */ if (Tcl_ObjSetVar2(interp, objv[2], NULL, dataObj, - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) != NULL) { + TCL_LEAVE_ERR_MSG) != NULL) { Tcl_SetObjResult (interp, saveResult); /* Restore old message */ } Tcl_DecrRefCount (saveResult); diff --git a/generic/tclXlib.c b/generic/tclXlib.c index 0903fe04..e31cff68 100644 --- a/generic/tclXlib.c +++ b/generic/tclXlib.c @@ -546,7 +546,7 @@ ProcessIndexFile (Tcl_Interp *interp, if ((Tcl_SplitList (interp, lineBuffer.string, &lineArgc, &lineArgv) != TCL_OK) || (lineArgc < 4)) - goto formatError; + goto reachedEOF; /* * lineArgv [0] is the package name. diff --git a/generic/tclXlist.c b/generic/tclXlist.c index ab5d0e9a..37848e74 100644 --- a/generic/tclXlist.c +++ b/generic/tclXlist.c @@ -92,7 +92,7 @@ TclX_LvarcatObjCmd (ClientData clientData, * Get the variable that we are going to update. Include it if it * exists. */ - varObjPtr = Tcl_GetVar2Ex(interp, varName, NULL, TCL_PARSE_PART1); + varObjPtr = Tcl_GetVar2Ex(interp, varName, NULL, 0); if (varObjPtr != NULL) { catObjc = objc - 1; @@ -120,7 +120,7 @@ TclX_LvarcatObjCmd (ClientData clientData, ckfree ((char *) catObjv); if (Tcl_SetVar2Ex(interp, varName, NULL, newObjPtr, - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) == NULL) { + TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount (newObjPtr); return TCL_ERROR; } @@ -150,7 +150,7 @@ TclX_LvarpopObjCmd (ClientData clientData, varName = Tcl_GetStringFromObj (objv [1], NULL); listVarPtr = Tcl_GetVar2Ex(interp, varName, NULL, - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG); + TCL_LEAVE_ERR_MSG); if (listVarPtr == NULL) { return TCL_ERROR; } @@ -201,7 +201,7 @@ TclX_LvarpopObjCmd (ClientData clientData, * Update variable. */ if (Tcl_SetVar2Ex(interp, varName, NULL, listVarPtr, - TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG) == NULL) { + TCL_LEAVE_ERR_MSG) == NULL) { goto errorExit; } @@ -244,7 +244,7 @@ TclX_LvarpushObjCmd (ClientData clientData, } varName = Tcl_GetStringFromObj (objv [1], NULL); - listVarPtr = Tcl_GetVar2Ex(interp, varName, NULL, TCL_PARSE_PART1); + listVarPtr = Tcl_GetVar2Ex(interp, varName, NULL, 0); if ((listVarPtr == NULL) || (Tcl_IsShared (listVarPtr))) { if (listVarPtr == NULL) { listVarPtr = Tcl_NewListObj (0, NULL); @@ -282,7 +282,7 @@ TclX_LvarpushObjCmd (ClientData clientData, goto errorExit; if (Tcl_SetVar2Ex(interp, varName, NULL, listVarPtr, - TCL_PARSE_PART1| TCL_LEAVE_ERR_MSG) == NULL) { + TCL_LEAVE_ERR_MSG) == NULL) { goto errorExit; } return TCL_OK; @@ -372,7 +372,7 @@ TclX_LassignObjCmd (ClientData clientData, elemPtr = nullObjPtr; } if (Tcl_SetVar2Ex(interp, Tcl_GetStringFromObj(objv [idx], NULL), NULL, - elemPtr, TCL_PARSE_PART1 | TCL_LEAVE_ERR_MSG) == NULL) + elemPtr, TCL_LEAVE_ERR_MSG) == NULL) goto error_exit; } diff --git a/generic/tclXmath.c b/generic/tclXmath.c index fddc4d61..6fa6ad5c 100644 --- a/generic/tclXmath.c +++ b/generic/tclXmath.c @@ -63,11 +63,6 @@ static int TclX_MinObjCmd (ClientData clientData, int objc, Tcl_Obj *CONST objv[]); -static int TclX_MinMaxFunc (ClientData clientData, - Tcl_Interp *interp, - Tcl_Value *args, - Tcl_Value *resultPtr); - static int TclX_RandomObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, @@ -178,75 +173,6 @@ static int TclX_MinObjCmd (ClientData clientData, return TCL_OK; } -/*----------------------------------------------------------------------------- - * - * TclX_MaxFunc -- - * Implements the Tcl max math function - * expr max(num1, num2) - * - * Results: - * Standard TCL results. - * - *----------------------------------------------------------------------------- - */ -static int TclX_MinMaxFunc (ClientData clientData, - Tcl_Interp *interp, - Tcl_Value *args, - Tcl_Value *resultPtr) -{ - size_t isMax = (size_t) clientData; - Tcl_ValueType t0 = args[0].type; - Tcl_ValueType t1 = args[1].type; - - if ((t1 == TCL_DOUBLE) || (t0 == TCL_DOUBLE)) { - double d0, d1; - /* - * Compare as doubles. - */ - GET_DOUBLE_VALUE(d0, args[0], t0); - GET_DOUBLE_VALUE(d1, args[1], t1); - - resultPtr->type = TCL_DOUBLE; - if (isMax) { - resultPtr->doubleValue = (d0 < d1) ? d1 : d0; - } else { - resultPtr->doubleValue = (d0 > d1) ? d1 : d0; - } -#ifdef TCL_WIDE_INT_TYPE - } else if ((t1 == TCL_WIDE_INT) || (t0 == TCL_WIDE_INT)) { - Tcl_WideInt w0, w1; - /* - * Compare as wide ints (neither are doubles) - */ - w0 = (t0 == TCL_INT) ? Tcl_LongAsWide(args[0].intValue) : - args[0].wideValue; - w1 = (t1 == TCL_INT) ? Tcl_LongAsWide(args[1].intValue) : - args[1].wideValue; - - resultPtr->type = TCL_WIDE_INT; - if (isMax) { - resultPtr->wideValue = (w0 < w1) ? w1 : w0; - } else { - resultPtr->wideValue = (w0 > w1) ? w1 : w0; - } -#endif - } else { - /* - * Compare as ints. - */ - long i0 = args[0].intValue; - long i1 = args[1].intValue; - - resultPtr->type = TCL_INT; - if (isMax) { - resultPtr->intValue = (i0 < i1) ? i1 : i0; - } else { - resultPtr->intValue = (i0 > i1) ? i1 : i0; - } - } - return TCL_OK; -} - /*----------------------------------------------------------------------------- * ReallyRandom -- * Insure a good random return for a range, unlike an arbitrary @@ -335,11 +261,6 @@ static int TclX_RandomObjCmd (ClientData clientData, void TclX_MathInit (Tcl_Interp *interp) { - int major, minor; - Tcl_ValueType minMaxArgTypes[2]; - - minMaxArgTypes[0] = TCL_EITHER; - minMaxArgTypes[1] = TCL_EITHER; Tcl_CreateObjCommand (interp, "max", TclX_MaxObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); @@ -350,17 +271,6 @@ TclX_MathInit (Tcl_Interp *interp) Tcl_CreateObjCommand (interp, "random", TclX_RandomObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL); - /* - * Tcl 8.5 added core min/max expr functions - */ - Tcl_GetVersion(&major, &minor, NULL, NULL); - if ((major == 8) && (minor <= 4)) { - Tcl_CreateMathFunc(interp, "max", 2, minMaxArgTypes, - TclX_MinMaxFunc, (ClientData) 1 /* IS_MAX */); - - Tcl_CreateMathFunc (interp, "min", 2, minMaxArgTypes, - TclX_MinMaxFunc, (ClientData) 0 /* IS_MIN */); - } } diff --git a/generic/tclXprofile.c b/generic/tclXprofile.c index 9143a664..f3190bf4 100644 --- a/generic/tclXprofile.c +++ b/generic/tclXprofile.c @@ -228,7 +228,7 @@ PushEntry (profInfo_t *infoPtr, * Only global level can be NULL. */ if (scanPtr == NULL) - panic (PROF_PANIC, 1); + Tcl_Panic (PROF_PANIC, 1); } entryPtr->prevScopePtr = scanPtr; infoPtr->scopeChainPtr = entryPtr; @@ -434,7 +434,7 @@ ProfCommandEvalSetup (profInfo_t *infoPtr, int *isProcPtr) UpdateTOSTimes (infoPtr); do { if (infoPtr->stackPtr->evalLevel != UNKNOWN_LEVEL) - panic (PROF_PANIC, 2); /* Not an initial entry */ + Tcl_Panic (PROF_PANIC, 2); /* Not an initial entry */ PopEntry (infoPtr); } while (infoPtr->stackPtr->procLevel > procLevel); } @@ -569,7 +569,7 @@ ProfTraceRoutine (ClientData clientData, Tcl_CmdInfo cmdInfo; if (cmd == NULL) - panic (PROF_PANIC, 4); + Tcl_Panic (PROF_PANIC, 4); //TIP #571: We don' want to profile the tailcall itself. As it can only be called in a procedure/lambda context if ( ! strcmp((*objv)->bytes, "tailcall") ) { diff --git a/generic/tclXsignal.c b/generic/tclXsignal.c index 385601ae..5c286520 100644 --- a/generic/tclXsignal.c +++ b/generic/tclXsignal.c @@ -682,7 +682,7 @@ FormatTrapCode (Tcl_Interp *interp, int signalNum, Tcl_DString *command) scanPtr += 2; copyPtr = scanPtr; } - Tcl_DStringAppend (command, copyPtr, copyPtr - scanPtr); + Tcl_DStringAppend (command, copyPtr, -1); return TCL_OK; @@ -1540,7 +1540,7 @@ SignalCmdCleanUp (ClientData clientData, Tcl_Interp *interp) break; } if (idx == numInterps) - panic ("signal interp lost"); + Tcl_Panic ("signal interp lost"); interpTable [idx] = interpTable [--numInterps]; diff --git a/generic/tclXstring.c b/generic/tclXstring.c index 2c421693..fb2ef8b3 100644 --- a/generic/tclXstring.c +++ b/generic/tclXstring.c @@ -379,7 +379,7 @@ TclX_CtokenObjCmd (ClientData clientData, } stringVarObj = Tcl_ObjGetVar2(interp, objv[1], NULL, - TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); + TCL_LEAVE_ERR_MSG); if (stringVarObj == NULL) { return TCL_ERROR; } @@ -416,7 +416,7 @@ TclX_CtokenObjCmd (ClientData clientData, strByteLen-strByteIdx); if (Tcl_SetVar2Ex(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL, newVarValueObj, - TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1) == NULL) { + TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DStringFree (&token); Tcl_DecrRefCount (newVarValueObj); return TCL_ERROR; @@ -666,7 +666,7 @@ TclX_CtypeObjCmd (ClientData clientData, #define IS_8BIT_UNICHAR(c) (c <= 255) if (TCL_UTF_MAX > sizeof(number)) { - panic("TclX_CtypeObjCmd: UTF character longer than a int"); + Tcl_Panic("TclX_CtypeObjCmd: UTF character longer than a int"); } /*FIX: Split into multiple procs */ @@ -853,7 +853,7 @@ TclX_CtypeObjCmd (ClientData clientData, Tcl_Obj *iObj = Tcl_NewIntObj (idx); if (Tcl_SetVar2Ex(interp, failVar, NULL, - iObj, TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1) == NULL) { + iObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount (iObj); return TCL_ERROR; } diff --git a/generic/tclXutil.c b/generic/tclXutil.c index 90cc9d1a..67ed0956 100644 --- a/generic/tclXutil.c +++ b/generic/tclXutil.c @@ -333,7 +333,7 @@ TclX_RelativeExpr (Tcl_Interp *interp, long longResult; char staticBuf [32]; - if (exprPtr->typePtr == Tcl_GetObjType ("int")) { + if (exprPtr != NULL && exprPtr->typePtr != NULL && exprPtr->typePtr == Tcl_GetObjType ("int")) { if (Tcl_GetIntFromObj (interp, exprPtr, exprResultPtr) != TCL_OK) return TCL_ERROR; return TCL_OK; @@ -476,7 +476,7 @@ ParseTranslationOption (char *strValue) } else if (STREQU (strValue, "platform")) { return TCLX_TRANSLATE_PLATFORM; } - panic ("ParseTranslationOption bug"); + Tcl_Panic ("ParseTranslationOption bug"); return TCL_ERROR; /* Not reached */ } @@ -507,7 +507,7 @@ FormatTranslationOption (int value) case TCLX_TRANSLATE_PLATFORM: return "platform"; default: - panic ("FormatTranslationOption bug"); + Tcl_Panic ("FormatTranslationOption bug"); } return NULL; /* Not reached */ } @@ -620,7 +620,7 @@ TclX_GetChannelOption (Tcl_Interp *interp, return TCL_OK; fatalError: - panic ("TclX_GetChannelOption bug"); /* FIX: return error. */ + Tcl_Panic ("TclX_GetChannelOption bug"); /* FIX: return error. */ return 0; /* Not reached */ } @@ -791,14 +791,13 @@ TclX_WrongArgs (Tcl_Interp *interp, Tcl_Obj *commandNameObj, char *string) *----------------------------------------------------------------------------- */ void -TclX_AppendObjResult TCL_VARARGS_DEF (Tcl_Interp *, arg1) +TclX_AppendObjResult (Tcl_Interp *interp, ...) { - Tcl_Interp *interp; Tcl_Obj *resultPtr; va_list argList; char *string; - interp = TCL_VARARGS_START (Tcl_Interp *, arg1, argList); + va_start(argList, interp); resultPtr = Tcl_GetObjResult (interp); if (Tcl_IsShared(resultPtr)) { @@ -806,7 +805,6 @@ TclX_AppendObjResult TCL_VARARGS_DEF (Tcl_Interp *, arg1) Tcl_SetObjResult(interp, resultPtr); } - TCL_VARARGS_START(Tcl_Interp *,arg1,argList); while (1) { string = va_arg(argList, char *); if (string == NULL) { diff --git a/library/profrep.tcl b/library/profrep.tcl index 1624ffde..6a736423 100644 --- a/library/profrep.tcl +++ b/library/profrep.tcl @@ -70,7 +70,7 @@ namespace eval TclXProfRep { proc sort {profDataVar sortKey} { upvar $profDataVar profData - case $sortKey { + switch $sortKey { {calls} {set keyIndex 0} {real} {set keyIndex 1} {cpu} {set keyIndex 2} diff --git a/library/tclx.tcl b/library/tclx.tcl index 4abe5351..63d46566 100644 --- a/library/tclx.tcl +++ b/library/tclx.tcl @@ -22,7 +22,7 @@ namespace eval ::tclx { arrayprocs.tcl 1 autoload.tcl 0 buildhelp.tcl 0 - buildidx.tcl 0 + buildidx.tcl 1 compat.tcl 1 convlib.tcl 1 edprocs.tcl 1 diff --git a/tests/all.tcl b/tests/all.tcl index bfefb033..f1391602 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -41,7 +41,7 @@ if {[llength $::tcltest::matchFiles] > 0} { set timeCmd {clock format [clock seconds]} puts stdout "Tests began at [eval $timeCmd]" -package require Tclx 8.6 +package require Tclx # Hook to determine if any of the tests failed. Then we can exit with diff --git a/tests/arrayproc.test b/tests/arrayproc.test index 493f9fc4..26a5437c 100644 --- a/tests/arrayproc.test +++ b/tests/arrayproc.test @@ -21,7 +21,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import ::tcltest::* } -package require Tclx 8.4 +package require Tclx set testArray(foo) bar set testArray(snap) frammistan diff --git a/tests/chmod.test b/tests/chmod.test index 0b13a988..fdd9e4fb 100644 --- a/tests/chmod.test +++ b/tests/chmod.test @@ -35,7 +35,7 @@ if [cequal $tcl_platform(platform) windows] { proc GetMode {filename} { file stat $filename stat - return [format "%o" [expr {$stat(mode) & 07777}]] + return [format "%o" [expr {$stat(mode) & 0o07777}]] } #----------------------------------------------------------------------------- diff --git a/tests/convlib.test b/tests/convlib.test index 27c08aec..5c00bad2 100644 --- a/tests/convlib.test +++ b/tests/convlib.test @@ -70,6 +70,7 @@ Test convlib-1.2 {Convert library tests} { list [file exists convlib.tmp/tmp.tlib] [file exists convlib.tmp/tmp.tndx] } 0 {1 1} + loadlibindex convlib.tmp/tmp.tlib LibValidate convlib-1.3 {Convert library tests} diff --git a/tests/filescan.test b/tests/filescan.test index c1cb3a32..9e2a0b7f 100644 --- a/tests/filescan.test +++ b/tests/filescan.test @@ -31,10 +31,10 @@ proc IncrName {Name args} { set Begin [csubstr $Name 0 $Last] set Digit [cindex $Name $Last] set Recurse 0 - case $Digit in { - {9} {set Digit A} - {Z} {if {$Upper} {set Recurse 1} else {set Digit a}} - {z} {set Recurse 1} + switch $Digit { + 9 {set Digit A} + Z {if {$Upper} {set Recurse 1} else {set Digit a}} + z {set Recurse 1} default {set Digit [ctype char [expr [ctype ord $Digit]+1]]} } if {$Recurse} { @@ -146,11 +146,11 @@ foreach scanInfo $scanList { set key [keylget scanInfo key] set matchType [keylget scanInfo matchType] set cmd "global matchInfo; ValMatch [list $scanInfo] 1.1" - case $matchType in { - {0} {scanmatch -nocase $testCH [string toupper $key] $cmd} - {1} {scanmatch $testCH ^$key $cmd} - {2} {scanmatch $testCH $key\$ $cmd} - {3} {scanmatch $testCH $key $cmd} + switch $matchType { + 0 {scanmatch -nocase $testCH [string toupper $key] $cmd} + 1 {scanmatch $testCH ^$key $cmd} + 2 {scanmatch $testCH $key\$ $cmd} + 3 {scanmatch $testCH $key $cmd} } } diff --git a/tests/fstat.test b/tests/fstat.test index 436d34bb..84c05501 100644 --- a/tests/fstat.test +++ b/tests/fstat.test @@ -44,7 +44,7 @@ if [cequal $tcl_platform(platform) windows] { test fstat-1.2 {array return} { catch {unset stat} fstat $gorpFH stat stat - list $stat(nlink) $stat(size) [expr $stat(mode)&0777] $stat(type) \ + list $stat(nlink) $stat(size) [expr $stat(mode)&0o0777] $stat(type) $stat(tty) } $expect @@ -74,7 +74,7 @@ if [cequal $tcl_platform(platform) windows] { test fstat-2.2 {keyed list returns} { set stat [fstat $gorpFH] list [keylget stat nlink] [keylget stat size] \ - [expr [keylget stat mode ]&0777] [keylget stat type] + [expr [keylget stat mode ]&0o0777] [keylget stat type] } $expect if [cequal $tcl_platform(platform) windows] { diff --git a/tests/lgets.test b/tests/lgets.test index e3220e63..8d6be30c 100644 --- a/tests/lgets.test +++ b/tests/lgets.test @@ -60,7 +60,7 @@ test lgets-1.6 {lgets command with long line} { test lgets-1.7 {lgets command with EOF in list element} { set f [open test2.tmp w] - puts $f "Test1 \{Test2 " nonewline + puts -nonewline $f "Test1 \{Test2 " close $f set f [open test2.tmp] list [catch {lgets $f} msg] $msg @@ -70,7 +70,7 @@ catch {close $f} test lgets-1.8 {lgets command with EOF in list} { set f [open test2.tmp w] - puts $f "Test1\nTest2" nonewline + puts -nonewline $f "Test1\nTest2" close $f set f [open test2.tmp] set x {} diff --git a/tests/stringfil.test b/tests/stringfil.test index 87b200b9..1222b634 100644 --- a/tests/stringfil.test +++ b/tests/stringfil.test @@ -47,7 +47,7 @@ Test stringfile-2.3 {read_file command} { } 0 [crange $stringfileTestVar 0 2] Test stringfile-2.4 {read_file command} { - read_file STRINGFIL.DAT nonewline + read_file -nonewline STRINGFIL.DAT } 0 $stringfileTestVar TestRemove STRINGFIL.DAT diff --git a/tests/testlib.tcl b/tests/testlib.tcl index 9ed635ec..0482950a 100644 --- a/tests/testlib.tcl +++ b/tests/testlib.tcl @@ -25,7 +25,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } -package require Tclx 8.4 +package require Tclx foreach need { fchown fchmod flock fsync ftruncate msgcats posix_signals symlink diff --git a/unix/tclXunixDup.c b/unix/tclXunixDup.c index 135fb6f4..1c710899 100644 --- a/unix/tclXunixDup.c +++ b/unix/tclXunixDup.c @@ -86,7 +86,7 @@ TclXOSDupChannel(Tcl_Interp *interp, Tcl_Channel srcChannel, int mode, char *tar } else { Tcl_GetChannelHandle (srcChannel, TCL_WRITABLE, &handle); } - srcFileNum = (int) handle; + srcFileNum = (uintptr_t) handle; channelType = Tcl_GetChannelType (srcChannel); /* diff --git a/unix/tclXunixId.c b/unix/tclXunixId.c index 8fcf59b3..c8972386 100644 --- a/unix/tclXunixId.c +++ b/unix/tclXunixId.c @@ -444,9 +444,9 @@ IdHost (Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[]) #endif char hostNameBuf[MAXHOSTNAMELEN]; - if (objc != 2) + if (objc != 2) { return TclX_WrongArgs (interp, objv [0], "host"); - + } if (gethostname (hostNameBuf, MAXHOSTNAMELEN) < 0) { TclX_AppendObjResult (interp, Tcl_PosixError (interp), (char *) NULL); diff --git a/unix/tclXunixOS.c b/unix/tclXunixOS.c index bcb2e3db..5d955f10 100644 --- a/unix/tclXunixOS.c +++ b/unix/tclXunixOS.c @@ -113,7 +113,7 @@ ChannelToFnum (Tcl_Channel channel, int direction) return -1; } } - return (int) handle; + return (uintptr_t) handle; } /*----------------------------------------------------------------------------- @@ -401,7 +401,7 @@ TclXOSsystem (Tcl_Interp *interp, char *command, int *exitCode) if (pid == 0) { close (errPipes [0]); execl ("/bin/sh", "sh", "-c", command, (char *) NULL); - write (errPipes [1], &errno, sizeof (errno)); + if (write (errPipes [1], &errno, sizeof (errno)) == 0) {} _exit (127); } @@ -919,7 +919,7 @@ int TclXOSgetsockname (Tcl_Interp *interp, Tcl_Channel channel, void *sockaddr, int sockaddrSize) { if (getsockname (ChannelToFnum (channel, 0), - (struct sockaddr *) sockaddr, &sockaddrSize) < 0) { + (struct sockaddr *) sockaddr, (socklen_t *__restrict) &sockaddrSize) < 0) { TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", Tcl_PosixError (interp), (char *) NULL); return TCL_ERROR; @@ -946,7 +946,7 @@ TclXOSgetsockopt (Tcl_Interp *interp, Tcl_Channel channel, int option, socklen_t int valueLen = sizeof (*valuePtr); if (getsockopt (ChannelToFnum (channel, 0), SOL_SOCKET, option, - (void*) valuePtr, &valueLen) != 0) { + (void*) valuePtr, (socklen_t *__restrict) &valueLen) != 0) { TclX_AppendObjResult (interp, Tcl_GetChannelName (channel), ": ", Tcl_PosixError (interp), (char *) NULL); return TCL_ERROR; @@ -1385,7 +1385,7 @@ TclXOSGetSelectFnum (Tcl_Interp *interp, Tcl_Channel channel, int direction, int (char *) NULL); return TCL_ERROR; } - *fnumPtr = (int) handle; + *fnumPtr = (uintptr_t) handle; return TCL_OK; }