diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2019-04-04 21:31:01 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2019-04-04 21:31:01 (GMT) |
commit | 889e874282cb68715c4fa329df827d6fe0ebc84d (patch) | |
tree | 821a4ea16fdaf69e0027f11970bfa888248fe9af | |
parent | 7d8a7adc9fda349a9676b23e95dc03fb6af56f93 (diff) | |
parent | 68d03f6af89984e9495654c0637685ab7708b3f6 (diff) | |
download | tcl-889e874282cb68715c4fa329df827d6fe0ebc84d.zip tcl-889e874282cb68715c4fa329df827d6fe0ebc84d.tar.gz tcl-889e874282cb68715c4fa329df827d6fe0ebc84d.tar.bz2 |
Merge 8.7
Undo Tcl-specific changes in bn_mp_sqrt.c, and re-enable the two disabled test-cases: This proves the observed crash with DIBIT_BIT=60 is caused by those Tcl-specific changes!
-rw-r--r-- | doc/info.n | 4 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 6 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 12 | ||||
-rw-r--r-- | generic/tclProcess.c | 4 | ||||
-rw-r--r-- | generic/tclTest.c | 21 | ||||
-rw-r--r-- | generic/tclTestObj.c | 26 | ||||
-rw-r--r-- | generic/tclTestProcBodyObj.c | 2 | ||||
-rw-r--r-- | generic/tclUtil.c | 6 | ||||
-rw-r--r-- | generic/tclZlib.c | 6 | ||||
-rw-r--r-- | libtommath/bn_mp_sqrt.c | 72 | ||||
-rw-r--r-- | macosx/tclMacOSXFCmd.c | 10 | ||||
-rw-r--r-- | tests/cmdMZ.test | 7 | ||||
-rw-r--r-- | tests/expr.test | 8 | ||||
-rw-r--r-- | tests/obj.test | 28 | ||||
-rw-r--r-- | tests/utf.test | 4 | ||||
-rw-r--r-- | unix/tclUnixFCmd.c | 20 | ||||
-rw-r--r-- | win/tclWinFCmd.c | 2 |
17 files changed, 99 insertions, 139 deletions
@@ -212,7 +212,7 @@ procedures nested in statically defined procedures, and literal eval scripts in files or statically defined procedures, its type is \fBsource\fR and its location is the absolute line number in the script. Otherwise, its type is \fBproc\fR and its location is its line number within the body of the -procedure. +procedure. .PP In contrast, procedure definitions and \fBeval\fR within a dynamically \fBeval\fRuated environment count line numbers relative to the start of @@ -300,7 +300,7 @@ described \fBOBJECT INTROSPECTION\fR below. .TP \fBinfo patchlevel\fR . -Returns the value of the global variable \fBtcl_patchLevel\fR, in which the +Returns the value of the global variable \fBtcl_patchLevel\fR, in which the exact version of the Tcl library initially stored. .TP \fBinfo procs \fR?\fIpattern\fR? diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 331f791..1811c5c 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -932,7 +932,7 @@ Tcl_ExitObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int value; + Tcl_WideInt value; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?"); @@ -941,10 +941,10 @@ Tcl_ExitObjCmd( if (objc == 1) { value = 0; - } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) { + } else if (TclGetWideBitsFromObj(interp, objv[1], &value) != TCL_OK) { return TCL_ERROR; } - Tcl_Exit(value); + Tcl_Exit((int)value); /*NOTREACHED*/ return TCL_OK; /* Better not ever reach this! */ } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 8767ca6..2671d49 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4373,6 +4373,11 @@ usage: middle *= TclpWideClickInMicrosec(); #endif + if (!count) { /* no iterations - avoid divide by zero */ + objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0); + goto retRes; + } + /* if not calibrate */ if (!calibrate) { /* minimize influence of measurement overhead */ @@ -4425,9 +4430,14 @@ usage: objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000); } + retRes: /* estimated net execution time (in millisecs) */ if (!calibrate) { - objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000); + if (middle >= 1) { + objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000); + } else { + objs[6] = Tcl_NewWideIntObj(0); + } TclNewLiteralStringObj(objs[7], "nett-ms"); } diff --git a/generic/tclProcess.c b/generic/tclProcess.c index a781386..2f3f4ba 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -540,7 +540,7 @@ ProcessStatusObjCmd( dict = Tcl_NewDictObj(); Tcl_MutexLock(&infoTablesMutex); for (i = 0; i < numPids; i++) { - result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); + result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid); if (result != TCL_OK) { Tcl_MutexUnlock(&infoTablesMutex); Tcl_DecrRefCount(dict); @@ -654,7 +654,7 @@ ProcessPurgeObjCmd( } Tcl_MutexLock(&infoTablesMutex); for (i = 0; i < numPids; i++) { - result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid); + result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid); if (result != TCL_OK) { Tcl_MutexUnlock(&infoTablesMutex); return result; diff --git a/generic/tclTest.c b/generic/tclTest.c index dde4496..26f2c37 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -53,6 +53,7 @@ DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp); static Tcl_DString delString; static Tcl_Interp *delInterp; +static const Tcl_ObjType *properByteArrayType; /* * One of the following structures exists for each asynchronous handler @@ -553,8 +554,7 @@ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { - Tcl_Obj *listPtr; - Tcl_Obj **objv; + Tcl_Obj **objv, *objPtr; int objc, index; static const char *const specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", @@ -576,6 +576,11 @@ Tcltest_Init( return TCL_ERROR; } + objPtr = Tcl_NewStringObj("abc", 3); + (void)Tcl_GetByteArrayFromObj(objPtr, &index); + properByteArrayType = objPtr->typePtr; + Tcl_DecrRefCount(objPtr); + /* * Create additional commands and math functions for testing Tcl. */ @@ -741,9 +746,9 @@ Tcltest_Init( * Check for special options used in ../tests/main.test */ - listPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); - if (listPtr != NULL) { - if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { + objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); + if (objPtr != NULL) { + if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { return TCL_ERROR; } if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL, @@ -5012,7 +5017,7 @@ TestbytestringObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int n; + int n = 0; const char *p; if (objc != 2) { @@ -5020,6 +5025,10 @@ TestbytestringObjCmd( return TCL_ERROR; } p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n); + if ((p == NULL) || !Tcl_FetchIntRep(objv[1], properByteArrayType)) { + Tcl_AppendResult(interp, "testbytestring expects bytes", NULL); + return TCL_ERROR; + } Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); return TCL_OK; } diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 8f12fd6..a289e32 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -385,9 +385,9 @@ TestbooleanobjCmd( */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetBooleanObj(varPtr[varIndex], boolValue); + Tcl_SetWideIntObj(varPtr[varIndex], boolValue != 0); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue != 0)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "get") == 0) { @@ -410,9 +410,9 @@ TestbooleanobjCmd( return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetBooleanObj(varPtr[varIndex], !boolValue); + Tcl_SetWideIntObj(varPtr[varIndex], boolValue == 0); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue == 0)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else { @@ -658,7 +658,7 @@ TestintobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int intValue, varIndex, i; - long longValue; + Tcl_WideInt wideValue; const char *index, *subCmd, *string; Tcl_Obj **varPtr; @@ -713,7 +713,7 @@ TestintobjCmd( } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue)); } - } else if (strcmp(subCmd, "setlong") == 0) { + } else if (strcmp(subCmd, "setint") == 0) { if (objc != 4) { goto wrongNumArgs; } @@ -728,28 +728,28 @@ TestintobjCmd( SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue)); } Tcl_SetObjResult(interp, varPtr[varIndex]); - } else if (strcmp(subCmd, "setmaxlong") == 0) { - long maxLong = LONG_MAX; + } else if (strcmp(subCmd, "setmax") == 0) { + Tcl_WideInt maxWide = WIDE_MAX; if (objc != 3) { goto wrongNumArgs; } if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetWideIntObj(varPtr[varIndex], maxLong); + Tcl_SetWideIntObj(varPtr[varIndex], maxWide); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxLong)); + SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxWide)); } - } else if (strcmp(subCmd, "ismaxlong") == 0) { + } else if (strcmp(subCmd, "ismax") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } - if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex], &wideValue) != TCL_OK) { return TCL_ERROR; } Tcl_AppendToObj(Tcl_GetObjResult(interp), - ((longValue == LONG_MAX)? "1" : "0"), -1); + ((wideValue == WIDE_MAX)? "1" : "0"), -1); } else if (strcmp(subCmd, "get") == 0) { if (objc != 3) { goto wrongNumArgs; diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index fba2844..913b253 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -340,7 +340,7 @@ ProcBodyTestCheckObjCmd( } version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); - Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( strcmp(version, packageVersion) == 0)); return TCL_OK; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 250a393..2889852 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3448,7 +3448,7 @@ TclPrecTraceProc( int flags) /* Information about what happened. */ { Tcl_Obj *value; - int prec; + Tcl_WideInt prec; int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int)); /* @@ -3488,11 +3488,11 @@ TclPrecTraceProc( } value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY); if (value == NULL - || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK + || Tcl_GetWideIntFromObj(NULL, value, &prec) != TCL_OK || prec < 0 || prec > TCL_MAX_PREC) { return (char *) "improper value for precision"; } - *precisionPtr = prec; + *precisionPtr = (int)prec; return NULL; } #endif /* !TCL_NO_DEPRECATED)*/ diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 32268af..5a7abec 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -422,6 +422,7 @@ GenerateHeader( { Tcl_Obj *value; int len, result = TCL_ERROR; + Tcl_WideInt wideValue; const char *valueStr; Tcl_Encoding latin1enc; static const char *const types[] = { @@ -485,10 +486,11 @@ GenerateHeader( if (GetValue(interp, dictObj, "time", &value) != TCL_OK) { goto error; - } else if (value != NULL && Tcl_GetLongFromObj(interp, value, - (long *) &headerPtr->header.time) != TCL_OK) { + } else if (value != NULL && Tcl_GetWideIntFromObj(interp, value, + &wideValue) != TCL_OK) { goto error; } + headerPtr->header.time = wideValue; if (GetValue(interp, dictObj, "type", &value) != TCL_OK) { goto error; diff --git a/libtommath/bn_mp_sqrt.c b/libtommath/bn_mp_sqrt.c index bbca158..ea93e74 100644 --- a/libtommath/bn_mp_sqrt.c +++ b/libtommath/bn_mp_sqrt.c @@ -12,20 +12,11 @@ * SPDX-License-Identifier: Unlicense */ -#ifndef NO_FLOATING_POINT -#include <math.h> -#endif - /* this function is less generic than mp_n_root, simpler and faster */ int mp_sqrt(const mp_int *arg, mp_int *ret) { int res; mp_int t1, t2; - int i, j, k; -#ifndef NO_FLOATING_POINT - volatile double d; - mp_digit dig; -#endif /* must be positive */ if (arg->sign == MP_NEG) { @@ -33,14 +24,12 @@ int mp_sqrt(const mp_int *arg, mp_int *ret) } /* easy out */ - if (mp_iszero(arg) == MP_YES) { + if (mp_iszero(arg)) { mp_zero(ret); return MP_OKAY; } - i = (arg->used / 2) - 1; - j = 2 * i; - if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) { + if ((res = mp_init_copy(&t1, arg)) != MP_OKAY) { return res; } @@ -48,61 +37,8 @@ int mp_sqrt(const mp_int *arg, mp_int *ret) goto E2; } - for (k = 0; k < i; ++k) { - t1.dp[k] = (mp_digit) 0; - } - -#ifndef NO_FLOATING_POINT - - /* Estimate the square root using the hardware floating point unit. */ - - d = 0.0; - for (k = arg->used-1; k >= j; --k) { - d = ldexp(d, DIGIT_BIT) + (double)(arg->dp[k]); - } - - /* - * At this point, d is the nearest floating point number to the most - * significant 1 or 2 mp_digits of arg. Extract its square root. - */ - - d = sqrt(d); - - /* dig is the most significant mp_digit of the square root */ - - dig = (mp_digit) ldexp(d, -DIGIT_BIT); - - /* - * If the most significant digit is nonzero, find the next digit down - * by subtracting DIGIT_BIT times thie most significant digit. - * Subtract one from the result so that our initial estimate is always - * low. - */ - - if (dig) { - t1.used = i+2; - d -= ldexp((double) dig, DIGIT_BIT); - if (d >= 1.0) { - t1.dp[i+1] = dig; - t1.dp[i] = ((mp_digit) d) - 1; - } else { - t1.dp[i+1] = dig-1; - t1.dp[i] = MP_DIGIT_MAX; - } - } else { - t1.used = i+1; - t1.dp[i] = ((mp_digit) d) - 1; - } - -#else - - /* Estimate the square root as having 1 in the most significant place. */ - - t1.used = i + 2; - t1.dp[i+1] = (mp_digit) 1; - t1.dp[i] = (mp_digit) 0; - -#endif + /* First approx. (not very bad for large arg) */ + mp_rshd(&t1, t1.used/2); /* t1 > 0 */ if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) { diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 1f7dcd8..7c65088 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -192,7 +192,7 @@ TclMacOSXGetFileAttribute( OSSwapBigToHostInt32(finder->type)); break; case MACOSX_HIDDEN_ATTRIBUTE: - *attributePtrPtr = Tcl_NewBooleanObj( + *attributePtrPtr = Tcl_NewWideIntObj( (finder->fdFlags & kFinfoIsInvisible) != 0); break; case MACOSX_RSRCLENGTH_ATTRIBUTE: @@ -580,7 +580,7 @@ GetOSTypeFromObj( if (!TclHasIntRep(objPtr, &tclOSTypeType)) { result = SetOSTypeFromAny(interp, objPtr); } - *osTypePtr = (OSType) objPtr->internalRep.longValue; + *osTypePtr = (OSType) objPtr->internalRep.wideValue; return result; } @@ -609,7 +609,7 @@ NewOSTypeObj( TclNewObj(objPtr); TclInvalidateStringRep(objPtr); - objPtr->internalRep.longValue = (long) osType; + objPtr->internalRep.wideValue = (Tcl_WideInt) osType; objPtr->typePtr = &tclOSTypeType; return objPtr; } @@ -660,7 +660,7 @@ SetOSTypeFromAny( (OSType) bytes[2] << 8 | (OSType) bytes[3]; TclFreeIntRep(objPtr); - objPtr->internalRep.longValue = (long) osType; + objPtr->internalRep.wideValue = (Tcl_WideInt) osType; objPtr->typePtr = &tclOSTypeType; } Tcl_DStringFree(&ds); @@ -694,7 +694,7 @@ UpdateStringOfOSType( { const int size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); - OSType osType = (OSType) objPtr->internalRep.longValue; + OSType osType = (OSType) objPtr->internalRep.wideValue; int written = 0; Tcl_Encoding encoding; char src[5]; diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 45231c8..d79e9f6 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -360,8 +360,11 @@ test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { test cmdMZ-6.4 {Tcl_TimeRateObjCmd: compile of script happens even with negative iteration counts} { list [catch {timerate "foreach a {c d e} \{" -12456} msg] $msg } {1 {missing close-brace}} -test cmdMZ-6.5 {Tcl_TimeRateObjCmd: result format and one iteration} { - regexp {^\d+.\d+ \ws/# 1 # \d+ #/sec \d+.\d+ nett-ms$} [timerate {} 0] +test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { + regexp {^\d+(?:\.\d+)? \ws/# 1 # \d+(?:\.\d+)? #/sec \d+(?:\.\d+)? nett-ms$} [timerate {} 0] +} 1 +test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { + regexp {^0 \ws/# 0 # 0 #/sec 0 nett-ms$} [timerate {} 0 0] } 1 test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { set m1 [timerate {after 0} 20] diff --git a/tests/expr.test b/tests/expr.test index 921ab17..cb0c24d 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -7087,7 +7087,7 @@ test expr-47.11 {isqrt of zero} { expr {isqrt(0)} } 0 -test expr-47.12 {isqrt of various sizes of integer} -constraints knownBug -body { +test expr-47.12 {isqrt of various sizes of integer} { set faults 0 set trouble {} for {set i 0} {$faults < 10 && $i <= 1024} {incr i} { @@ -7114,9 +7114,9 @@ test expr-47.12 {isqrt of various sizes of integer} -constraints knownBug -body } } set trouble -} -result {} +} {} -test expr-47.13 {isqrt and floating point rounding (Bug 2143288)} -constraints knownBug -body { +test expr-47.13 {isqrt and floating point rounding (Bug 2143288)} { set trouble {} set faults 0 for {set i 0} {$i < 29 && $faults < 10} {incr i} { @@ -7134,7 +7134,7 @@ test expr-47.13 {isqrt and floating point rounding (Bug 2143288)} -constraints k } } set trouble -} -result {} +} {} test expr-48.1 {Bug 1770224} { expr {-0x8000000000000001 >> 0x8000000000000000} diff --git a/tests/obj.test b/tests/obj.test index 87c8d08..5bcffa3 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -476,11 +476,11 @@ test obj-26.1 {UpdateStringOfInt} testobj { lappend result [testintobj get 1] ;# must update string rep } {512 5120 5120} -test obj-27.1 {Tcl_NewLongObj} testobj { +test obj-27.1 {Tcl_NewWideObj} testobj { set result "" lappend result [testobj freeallvars] - testintobj setmaxlong 1 - lappend result [testintobj ismaxlong 1] + testintobj setmax 1 + lappend result [testintobj ismax 1] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 1 int 1} @@ -489,7 +489,7 @@ test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] - lappend result [testintobj setlong 1 77] ;# makes existing obj long int + lappend result [testintobj setint 1 77] ;# makes existing obj int lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 77 int 2} @@ -497,32 +497,32 @@ test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testdoubleobj set 1 12.34] - lappend result [testintobj setlong 1 77] ;# makes existing obj long int + lappend result [testintobj setint 1 77] ;# makes existing obj int lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 12.34 77 int 2} -test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} testobj { +test obj-29.1 {Tcl_GetWideIntFromObj, existing int object} testobj { set result "" - lappend result [testintobj setlong 1 22] - lappend result [testintobj mult10 1] ;# gets existing long int rep + lappend result [testintobj setint 1 22] + lappend result [testintobj mult10 1] ;# gets existingint rep } {22 220} -test obj-29.2 {Tcl_GetLongFromObj, convert to long} testobj { +test obj-29.2 {Tcl_GetWideIntFromObj, convert to int} testobj { set result "" - lappend result [testintobj setlong 1 477] + lappend result [testintobj setint 1 477] lappend result [testintobj div10 1] ;# must convert to bool lappend result [testobj type 1] } {477 47 int} -test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} testobj { +test obj-29.3 {Tcl_GetWideIntFromObj, error converting to int} testobj { set result "" lappend result [teststringobj set 1 abc] - lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int + lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int lappend result $msg } {abc 1 {expected integer but got "abc"}} -test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} testobj { +test obj-29.4 {Tcl_GetWideIntFromObj, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] - lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int + lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int lappend result $msg } {{} 1 {expected integer but got ""}} diff --git a/tests/utf.test b/tests/utf.test index f4926af..72b8d97 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -108,7 +108,7 @@ test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC2\xA2"] } {1} test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] + testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"] } {7} test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC0\x80"] @@ -120,7 +120,7 @@ test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestri testnumutfchars [testbytestring "\xC2\xA2"] 2 } {1} test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} { - testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 10 + testnumutfchars [testbytestring "abc\xC2\xA2\xE4\xB9\x8E\uA2\x4E"] 10 } {7} test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC0\x80"] 2 diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 7205085..e963589 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1499,11 +1499,11 @@ SetGroupAttribute( Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New group for file. */ { - long gid; + Tcl_WideInt gid; int result; const char *native; - if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) { + if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr = NULL; const char *string; @@ -1565,11 +1565,11 @@ SetOwnerAttribute( Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New owner for file. */ { - long uid; + Tcl_WideInt uid; int result; const char *native; - if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) { + if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; @@ -1631,7 +1631,7 @@ SetPermissionsAttribute( Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* The attribute to set. */ { - long mode; + Tcl_WideInt mode; mode_t newMode; int result = TCL_ERROR; const char *native; @@ -1650,11 +1650,11 @@ SetPermissionsAttribute( TclNewLiteralStringObj(modeObj, "0o"); Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1); - result = Tcl_GetLongFromObj(NULL, modeObj, &mode); + result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode); Tcl_DecrRefCount(modeObj); } if (result == TCL_OK - || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { + || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) { newMode = (mode_t) (mode & 0x00007FFF); } else { Tcl_StatBuf buf; @@ -2340,8 +2340,8 @@ GetUnixFileAttributes( return TCL_ERROR; } - *attributePtrPtr = Tcl_NewBooleanObj( - fileAttributes & attributeArray[objIndex]); + *attributePtrPtr = Tcl_NewWideIntObj( + (fileAttributes & attributeArray[objIndex]) != 0); return TCL_OK; } @@ -2440,7 +2440,7 @@ GetUnixFileAttributes( return TCL_ERROR; } - *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags & UF_IMMUTABLE); + *attributePtrPtr = Tcl_NewWideIntObj((statBuf.st_flags & UF_IMMUTABLE) != 0); return TCL_OK; } diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index a950714..14bb252 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1549,7 +1549,7 @@ GetWinFileAttributes( } } - *attributePtrPtr = Tcl_NewBooleanObj(attr); + *attributePtrPtr = Tcl_NewWideIntObj(attr != 0); return TCL_OK; } |