Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge 8.7 |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | tip-367 |
Files: | files | file ages | folders |
SHA3-256: |
a92f73b21e5d1e307cdb1d7a1b74e476 |
User & Date: | dgp 2019-04-12 20:15:37.668 |
Context
2019-04-14
| ||
14:17 | Implement TIP 367 check-in: 48745adfd3 user: dkf tags: core-8-branch | |
2019-04-12
| ||
20:15 | merge 8.7 Closed-Leaf check-in: a92f73b21e user: dgp tags: tip-367 | |
2019-04-11
| ||
20:37 | Merge 8.6 check-in: 2a6c012bff user: jan.nijtmans tags: core-8-branch | |
2019-03-30
| ||
12:54 | Added documentation check-in: b7911ee099 user: dkf tags: tip-367 | |
Changes
Changes to .travis.yml.
︙ | ︙ | |||
154 155 156 157 158 159 160 161 162 163 164 165 166 167 | packages: - gcc-mingw-w64-base - binutils-mingw-w64-i686 - gcc-mingw-w64-i686 - gcc-mingw-w64 - gcc-multilib - wine env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6" - NO_DIRECT_TEST=1 - os: linux dist: xenial compiler: i686-w64-mingw32-gcc | > > > > > > > > > > > > > > > > | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | packages: - gcc-mingw-w64-base - binutils-mingw-w64-i686 - gcc-mingw-w64-i686 - gcc-mingw-w64 - gcc-multilib - wine env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 --disable-shared" - NO_DIRECT_TEST=1 - os: linux dist: xenial compiler: i686-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-i686 - gcc-mingw-w64-i686 - gcc-mingw-w64 - gcc-multilib - wine env: - BUILD_DIR=win - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6" - NO_DIRECT_TEST=1 - os: linux dist: xenial compiler: i686-w64-mingw32-gcc |
︙ | ︙ | |||
207 208 209 210 211 212 213 214 215 216 217 218 219 220 | - gcc-mingw-w64 - wine env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" - NO_DIRECT_TEST=1 - os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-x86-64 | > > > > > > > > > > > > > > > | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 | - gcc-mingw-w64 - wine env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" - NO_DIRECT_TEST=1 - os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-x86-64 - gcc-mingw-w64-x86-64 - gcc-mingw-w64 - wine env: - BUILD_DIR=win - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared" - NO_DIRECT_TEST=1 - os: linux dist: xenial compiler: x86_64-w64-mingw32-gcc addons: apt: packages: - gcc-mingw-w64-base - binutils-mingw-w64-x86-64 |
︙ | ︙ |
Changes to doc/define.n.
︙ | ︙ | |||
280 281 282 283 284 285 286 | .VE TIP524 .TP \fBdeletemethod\fI name\fR ?\fIname ...\fR? . This deletes each of the methods called \fIname\fR from a class. The methods must have previously existed in that class. Does not affect the superclasses of the class, nor does it affect the subclasses or instances of the class | | > | 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 | .VE TIP524 .TP \fBdeletemethod\fI name\fR ?\fIname ...\fR? . This deletes each of the methods called \fIname\fR from a class. The methods must have previously existed in that class. Does not affect the superclasses of the class, nor does it affect the subclasses or instances of the class (except when they have a call chain through the class being modified) or the class object itself. .TP \fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR? . This slot (see \fBSLOTTED DEFINITIONS\fR below) sets or updates the list of method names that are used to guard whether method call to instances of the class may be called and what the method's results are. Each \fImethodName\fR names a single filtering method (which may |
︙ | ︙ | |||
306 307 308 309 310 311 312 | .TP \fBrenamemethod\fI fromName toName\fR . This renames the method called \fIfromName\fR in a class to \fItoName\fR. The method must have previously existed in the class, and \fItoName\fR must not previously refer to a method in that class. Does not affect the superclasses of the class, nor does it affect the subclasses or instances of the class | | > | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 | .TP \fBrenamemethod\fI fromName toName\fR . This renames the method called \fIfromName\fR in a class to \fItoName\fR. The method must have previously existed in the class, and \fItoName\fR must not previously refer to a method in that class. Does not affect the superclasses of the class, nor does it affect the subclasses or instances of the class (except when they have a call chain through the class being modified), or the class object itself. Does not change the export status of the method; if it was exported before, it will be afterwards. .SH "CONFIGURING OBJECTS" .PP The following commands are supported in the \fIdefScript\fR for \fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR form: |
︙ | ︙ | |||
432 433 434 435 436 437 438 | This allows the class of an object to be changed after creation. Note that the class's constructors are not called when this is done, and so the object may well be in an inconsistent state unless additional configuration work is done. .TP \fBdeletemethod\fI name\fR ?\fIname ...\fR . This deletes each of the methods called \fIname\fR from an object. The methods | | > | > | > > | | 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 | This allows the class of an object to be changed after creation. Note that the class's constructors are not called when this is done, and so the object may well be in an inconsistent state unless additional configuration work is done. .TP \fBdeletemethod\fI name\fR ?\fIname ...\fR . This deletes each of the methods called \fIname\fR from an object. The methods must have previously existed in that object (e.g., because it was created through \fBoo::objdefine method\fR). Does not affect the classes that the object is an instance of, or remove the exposure of those class-provided methods in the instance of that class. .TP \fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR? . This slot (see \fBSLOTTED DEFINITIONS\fR below) sets or updates the list of method names that are used to guard whether a method call to the object may be called and what the method's results are. Each \fImethodName\fR names a single filtering method (which may be exposed or not exposed); it is not an error for a non-existent method to be named. Note that the actual list of filters also depends on the filters set upon any classes that the object is an instance of. By default, this slot works by appending. .TP \fBrenamemethod\fI fromName toName\fR . This renames the method called \fIfromName\fR in an object to \fItoName\fR. The method must have previously existed in the object, and \fItoName\fR must not previously refer to a method in that object. Does not affect the classes that the object is an instance of and cannot rename in an instance object the methods provided by those classes (though a \fBoo::objdefine forward\fRed method may provide an equivalent capability). Does not change the export status of the method; if it was exported before, it will be afterwards. .TP \fBself \fR .VS TIP470 This gives the name of the object currently being configured. .VE TIP470 .SH "PRIVATE METHODS" .VS TIP500 |
︙ | ︙ |
Changes to doc/info.n.
︙ | ︙ | |||
208 209 210 211 212 213 214 | For a frame that corresponds to a level, (to be determined). .PP When a command can be traced to its literal definition in some script, e.g. 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 | | | 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | For a frame that corresponds to a level, (to be determined). .PP When a command can be traced to its literal definition in some script, e.g. 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. .PP In contrast, procedure definitions and \fBeval\fR within a dynamically \fBeval\fRuated environment count line numbers relative to the start of their script, even if they would be able to count relative to the start of the outer dynamic script. That type of number usually makes more sense. .PP |
︙ | ︙ | |||
296 297 298 299 300 301 302 | \fBinfo object\fI subcommand object\fR ?\fIarg ...\fR . Returns information about the object named \fIobject\fR. \fIsubcommand\fR is described \fBOBJECT INTROSPECTION\fR below. .TP \fBinfo patchlevel\fR . | | | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 | \fBinfo object\fI subcommand object\fR ?\fIarg ...\fR . Returns information about the object named \fIobject\fR. \fIsubcommand\fR is described \fBOBJECT INTROSPECTION\fR below. .TP \fBinfo patchlevel\fR . 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? . Returns the names of all visible procedures. If \fIpattern\fR is given, returns only those names that match according to \fBstring match\fR. Only the final component in \fIpattern\fR is actually considered a pattern. Any qualifying |
︙ | ︙ |
Changes to doc/interp.n.
︙ | ︙ | |||
197 198 199 200 201 202 203 | \fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR?? . Controls whether frame-level stack information is captured in the slave interpreter identified by \fIpath\fR. If no arguments are given, option and current setting are returned. If \fB\-frame\fR is given, the debug setting is set to the given boolean if provided and the current setting is returned. | | | 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 | \fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR?? . Controls whether frame-level stack information is captured in the slave interpreter identified by \fIpath\fR. If no arguments are given, option and current setting are returned. If \fB\-frame\fR is given, the debug setting is set to the given boolean if provided and the current setting is returned. This only affects the output of \fBinfo frame\fR, in that exact frame-level information for command invocation at the bytecode level is only captured with this setting on. .RS .PP For example, with code like .PP .CS |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
928 929 930 931 932 933 934 | int Tcl_ExitObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 | int Tcl_ExitObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_WideInt value; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?"); return TCL_ERROR; } if (objc == 1) { value = 0; } else if (TclGetWideBitsFromObj(interp, objv[1], &value) != TCL_OK) { return TCL_ERROR; } Tcl_Exit((int)value); /*NOTREACHED*/ return TCL_OK; /* Better not ever reach this! */ } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 | middle -= start; /* execution time in microsecs */ #ifdef TCL_WIDE_CLICKS /* convert execution time in wide clicks to microsecs */ middle *= TclpWideClickInMicrosec(); #endif /* if not calibrate */ if (!calibrate) { /* minimize influence of measurement overhead */ if (overhead > 0) { /* estimate the time of overhead (microsecs) */ Tcl_WideUInt curOverhead = overhead * count; | > > > > > | 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 | middle -= start; /* execution time in microsecs */ #ifdef TCL_WIDE_CLICKS /* convert execution time in wide clicks to microsecs */ 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 */ if (overhead > 0) { /* estimate the time of overhead (microsecs) */ Tcl_WideUInt curOverhead = overhead * count; |
︙ | ︙ | |||
4421 4422 4423 4424 4425 4426 4427 4428 4429 | } else { objs[4] = Tcl_NewWideIntObj(val); } } else { objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000); } /* estimated net execution time (in millisecs) */ if (!calibrate) { | > > | > > > | 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 | } else { objs[4] = Tcl_NewWideIntObj(val); } } else { objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000); } retRes: /* estimated net execution time (in millisecs) */ if (!calibrate) { if (middle >= 1) { objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000); } else { objs[6] = Tcl_NewWideIntObj(0); } TclNewLiteralStringObj(objs[7], "nett-ms"); } /* * Construct the result as a list because many programs have always parsed * as such (extracting the first element, typically). */ |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
5627 5628 5629 5630 5631 5632 5633 | if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; } else if (type1 == TCL_NUMBER_BIG) { /* value is an integer outside the WIDE_MIN to WIDE_MAX range */ /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */ Tcl_WideInt w; | | | 5627 5628 5629 5630 5631 5632 5633 5634 5635 5636 5637 5638 5639 5640 5641 | if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { type1 = 0; } else if (type1 == TCL_NUMBER_BIG) { /* value is an integer outside the WIDE_MIN to WIDE_MAX range */ /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */ Tcl_WideInt w; if (TclGetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) { type1 = TCL_NUMBER_INT; } } TclNewIntObj(objResultPtr, type1); TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1)); NEXT_INST_F(1, 1, 1); |
︙ | ︙ | |||
8395 8396 8397 8398 8399 8400 8401 | wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base]; WIDE_RESULT(wResult); } } overflowExpon: | > | < | | < < < | < | 8395 8396 8397 8398 8399 8400 8401 8402 8403 8404 8405 8406 8407 8408 8409 8410 8411 8412 8413 8414 8415 8416 8417 8418 8419 8420 | wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base]; WIDE_RESULT(wResult); } } overflowExpon: if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK) || (value2Ptr->typePtr != &tclIntType) || (Tcl_WideUInt)w2 >= (1<<28)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); mp_init(&bigResult); mp_expt_d_ex(&big1, w2, &bigResult, 1); mp_clear(&big1); BIG_RESULT(&bigResult); } case INST_ADD: case INST_SUB: case INST_MULT: case INST_DIV: |
︙ | ︙ |
Changes to generic/tclProcess.c.
︙ | ︙ | |||
536 537 538 539 540 541 542 | result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } dict = Tcl_NewDictObj(); Tcl_MutexLock(&infoTablesMutex); for (i = 0; i < numPids; i++) { | | | 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 | result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } dict = Tcl_NewDictObj(); Tcl_MutexLock(&infoTablesMutex); for (i = 0; i < numPids; i++) { result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid); if (result != TCL_OK) { Tcl_MutexUnlock(&infoTablesMutex); Tcl_DecrRefCount(dict); return result; } entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid)); |
︙ | ︙ | |||
650 651 652 653 654 655 656 | result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } Tcl_MutexLock(&infoTablesMutex); for (i = 0; i < numPids; i++) { | | | 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 | result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } Tcl_MutexLock(&infoTablesMutex); for (i = 0; i < numPids; i++) { result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid); if (result != TCL_OK) { Tcl_MutexUnlock(&infoTablesMutex); return result; } entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid)); if (!entry) { |
︙ | ︙ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
48 49 50 51 52 53 54 55 56 57 58 59 60 61 | /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect * the results of the various deletion callbacks. */ static Tcl_DString delString; static Tcl_Interp *delInterp; /* * One of the following structures exists for each asynchronous handler * created by the "testasync" command". */ typedef struct TestAsyncHandler { | > | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect * the results of the various deletion callbacks. */ static Tcl_DString delString; static Tcl_Interp *delInterp; static const Tcl_ObjType *properByteArrayType; /* * One of the following structures exists for each asynchronous handler * created by the "testasync" command". */ typedef struct TestAsyncHandler { |
︙ | ︙ | |||
548 549 550 551 552 553 554 | *---------------------------------------------------------------------- */ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { | < | > > > > > | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 | *---------------------------------------------------------------------- */ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { Tcl_Obj **objv, *objPtr; int objc, index; static const char *const specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) { return TCL_ERROR; } if (Tcl_TomMath_InitStubs(interp, "8.5-") == NULL) { return TCL_ERROR; } if (Tcl_OOInitStubs(interp) == NULL) { return TCL_ERROR; } /* TIP #268: Full patchlevel instead of just major.minor */ if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) { 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. */ Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); |
︙ | ︙ | |||
736 737 738 739 740 741 742 | } #endif /* * Check for special options used in ../tests/main.test */ | | | | | 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 | } #endif /* * Check for special options used in ../tests/main.test */ 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, TCL_EXACT, &index) == TCL_OK)) { switch (index) { case 0: return TCL_ERROR; |
︙ | ︙ | |||
5007 5008 5009 5010 5011 5012 5013 | static int TestbytestringObjCmd( void *unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { | | > > > > | 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 5027 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 | static int TestbytestringObjCmd( void *unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int n = 0; const char *p; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "bytearray"); 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; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
381 382 383 384 385 386 387 | * has ref count 1 (i.e. the object is unshared) we can modify that * object directly. Otherwise, if RC>1 (i.e. the object is shared), * we must create a new object to modify/set and decrement the old * formerly-shared object's ref count. This is "copy on write". */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { | | | | 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 | * has ref count 1 (i.e. the object is unshared) we can modify that * object directly. Otherwise, if RC>1 (i.e. the object is shared), * we must create a new object to modify/set and decrement the old * formerly-shared object's ref count. This is "copy on write". */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetWideIntObj(varPtr[varIndex], boolValue != 0); } else { SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue != 0)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "get") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { |
︙ | ︙ | |||
406 407 408 409 410 411 412 | return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex], &boolValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { | | | | 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 | return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex], &boolValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { Tcl_SetWideIntObj(varPtr[varIndex], boolValue == 0); } else { SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue == 0)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), "\": must be set, get, or not", NULL); return TCL_ERROR; |
︙ | ︙ | |||
654 655 656 657 658 659 660 | TestintobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int intValue, varIndex, i; | | | 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 | TestintobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int intValue, varIndex, i; Tcl_WideInt wideValue; const char *index, *subCmd, *string; Tcl_Obj **varPtr; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; |
︙ | ︙ | |||
709 710 711 712 713 714 715 | } intValue = i; if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], intValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue)); } | | | | | | | | | | 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 | } intValue = i; if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetIntObj(varPtr[varIndex], intValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue)); } } else if (strcmp(subCmd, "setint") == 0) { if (objc != 4) { goto wrongNumArgs; } string = Tcl_GetString(objv[3]); if (Tcl_GetInt(interp, string, &i) != TCL_OK) { return TCL_ERROR; } intValue = i; if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetWideIntObj(varPtr[varIndex], intValue); } else { SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } 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], maxWide); } else { SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxWide)); } } else if (strcmp(subCmd, "ismax") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex], &wideValue) != TCL_OK) { return TCL_ERROR; } Tcl_AppendToObj(Tcl_GetObjResult(interp), ((wideValue == WIDE_MAX)? "1" : "0"), -1); } else if (strcmp(subCmd, "get") == 0) { if (objc != 3) { goto wrongNumArgs; } if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } |
︙ | ︙ |
Changes to generic/tclTestProcBodyObj.c.
︙ | ︙ | |||
336 337 338 339 340 341 342 | if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); | | | 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 | if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } version = Tcl_PkgPresent(interp, packageName, packageVersion, 1); Tcl_SetObjResult(interp, Tcl_NewWideIntObj( strcmp(version, packageVersion) == 0)); return TCL_OK; } /* * Local Variables: * mode: c |
︙ | ︙ |
Changes to generic/tclTomMath.h.
1 2 3 4 5 6 7 8 9 | /* LibTomMath, multiple-precision integer library -- Tom St Denis * * LibTomMath is a library that provides multiple-precision * integer arithmetic as well as number theoretic functionality. * * The library was designed directly after the MPI library by * Michael Fromberger but has been written from scratch with * additional optimizations in place. * | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | /* LibTomMath, multiple-precision integer library -- Tom St Denis * * LibTomMath is a library that provides multiple-precision * integer arithmetic as well as number theoretic functionality. * * The library was designed directly after the MPI library by * Michael Fromberger but has been written from scratch with * additional optimizations in place. * * SPDX-License-Identifier: Unlicense */ #ifndef BN_H_ #define BN_H_ #include "tclTomMathDecls.h" #ifndef MODULE_SCOPE #define MODULE_SCOPE extern |
︙ | ︙ | |||
124 125 126 127 128 129 130 131 132 133 134 135 136 137 | #define MP_ZPOS 0 /* positive integer */ #define MP_NEG 1 /* negative */ #define MP_OKAY 0 /* ok result */ #define MP_MEM -2 /* out of mem */ #define MP_VAL -3 /* invalid input */ #define MP_RANGE MP_VAL #define MP_YES 1 /* yes response */ #define MP_NO 0 /* no response */ /* Primality generation flags */ #define LTM_PRIME_BBS 0x0001 /* BBS style prime */ #define LTM_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */ | > | 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 | #define MP_ZPOS 0 /* positive integer */ #define MP_NEG 1 /* negative */ #define MP_OKAY 0 /* ok result */ #define MP_MEM -2 /* out of mem */ #define MP_VAL -3 /* invalid input */ #define MP_RANGE MP_VAL #define MP_ITER -4 /* Max. iterations reached */ #define MP_YES 1 /* yes response */ #define MP_NO 0 /* no response */ /* Primality generation flags */ #define LTM_PRIME_BBS 0x0001 /* BBS style prime */ #define LTM_PRIME_SAFE 0x0002 /* Safe prime (p-1)/2 == prime */ |
︙ | ︙ | |||
342 343 344 345 346 347 348 | /* Counts the number of lsbs which are zero before the first zero bit */ /* int mp_cnt_lsb(const mp_int *a); */ /* I Love Earth! */ | | > > > > | > | < > | 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 | /* Counts the number of lsbs which are zero before the first zero bit */ /* int mp_cnt_lsb(const mp_int *a); */ /* I Love Earth! */ /* makes a pseudo-random mp_int of a given size */ /* int mp_rand(mp_int *a, int digits); */ /* makes a pseudo-random small int of a given size */ /* int mp_rand_digit(mp_digit *r); */ #ifdef MP_PRNG_ENABLE_LTM_RNG /* A last resort to provide random data on systems without any of the other * implemented ways to gather entropy. * It is compatible with `rng_get_bytes()` from libtomcrypt so you could * provide that one and then set `ltm_rng = rng_get_bytes;` */ extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void)); extern void (*ltm_rng_callback)(void); #endif /* ---> binary operations <--- */ /* c = a XOR b */ /* |
︙ | ︙ | |||
687 688 689 690 691 692 693 | /* This gives [for a given bit size] the number of trials required * such that Miller-Rabin gives a prob of failure lower than 2^-96 */ /* int mp_prime_rabin_miller_trials(int size); */ | | | > > > > > > > | 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 | /* This gives [for a given bit size] the number of trials required * such that Miller-Rabin gives a prob of failure lower than 2^-96 */ /* int mp_prime_rabin_miller_trials(int size); */ /* performs t random rounds of Miller-Rabin on "a" additional to * bases 2 and 3. Also performs an initial sieve of trial * division. Determines if "a" is prime with probability * of error no more than (1/4)**t. * Both a strong Lucas-Selfridge to complete the BPSW test * and a separate Frobenius test are available at compile time. * With t<0 a deterministic test is run for primes up to * 318665857834031151167461. With t<13 (abs(t)-13) additional * tests with sequential small primes are run starting at 43. * Is Fips 186.4 compliant if called with t as computed by * mp_prime_rabin_miller_trials(); * * Sets result to 1 if probably prime, 0 otherwise */ /* int mp_prime_is_prime(const mp_int *a, int t, int *result); */ |
︙ | ︙ |
Changes to generic/tclTomMathDecls.h.
︙ | ︙ | |||
26 27 28 29 30 31 32 | #define Tcl_TomMath_InitStubs(interp,version) \ (TclTomMathInitializeStubs((interp),(version),\ TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION)) /* Define custom memory allocation for libtommath */ | | | | | | | > > > > > | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | #define Tcl_TomMath_InitStubs(interp,version) \ (TclTomMathInitializeStubs((interp),(version),\ TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION)) /* Define custom memory allocation for libtommath */ /* MODULE_SCOPE void* TclBNAlloc( size_t ); */ #define TclBNAlloc(s) ((void*)ckalloc((size_t)(s))) /* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */ #define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s))) /* MODULE_SCOPE void TclBNFree( void* ); */ #define TclBNFree(x) (ckfree((char*)(x))) #define XMALLOC(size) TclBNAlloc(size) #define XFREE(mem, size) TclBNFree(mem) #define XREALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize) /* Rename the global symbols in libtommath to avoid linkage conflicts */ #define bn_reverse TclBN_reverse #define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs #define fast_s_mp_sqr TclBN_fast_s_mp_sqr #define mp_add TclBN_mp_add |
︙ | ︙ |
Changes to generic/tclTomMathInterface.c.
︙ | ︙ | |||
107 108 109 110 111 112 113 | */ void TclInitBignumFromWideInt( mp_int *a, /* Bignum to initialize */ Tcl_WideInt v) /* Initial value */ { | | | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | */ void TclInitBignumFromWideInt( mp_int *a, /* Bignum to initialize */ Tcl_WideInt v) /* Initial value */ { if (mp_init(a) != MP_OKAY) { Tcl_Panic("initialization failure in TclInitBignumFromWideInt"); } if (v < 0) { mp_set_long_long(a, (Tcl_WideUInt)(-v)); mp_neg(a, a); } else { mp_set_long_long(a, (Tcl_WideUInt)v); |
︙ | ︙ | |||
139 140 141 142 143 144 145 | */ void TclInitBignumFromWideUInt( mp_int *a, /* Bignum to initialize */ Tcl_WideUInt v) /* Initial value */ { | | | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 | */ void TclInitBignumFromWideUInt( mp_int *a, /* Bignum to initialize */ Tcl_WideUInt v) /* Initial value */ { if (mp_init(a) != MP_OKAY) { Tcl_Panic("initialization failure in TclInitBignumFromWideUInt"); } mp_set_long_long(a, v); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclUtil.c.
︙ | ︙ | |||
3444 3445 3446 3447 3448 3449 3450 | ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable. */ const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { Tcl_Obj *value; | | | 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 | ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable. */ const char *name2, /* Second part of variable name. */ int flags) /* Information about what happened. */ { Tcl_Obj *value; Tcl_WideInt prec; int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int)); /* * If the variable is unset, then recreate the trace. */ if (flags & TCL_TRACE_UNSETS) { |
︙ | ︙ | |||
3484 3485 3486 3487 3488 3489 3490 | */ if (Tcl_IsSafe(interp)) { return (char *) "can't modify precision from a safe interpreter"; } value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY); if (value == NULL | | | | 3484 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 3500 3501 3502 | */ if (Tcl_IsSafe(interp)) { return (char *) "can't modify precision from a safe interpreter"; } value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY); if (value == NULL || Tcl_GetWideIntFromObj(NULL, value, &prec) != TCL_OK || prec < 0 || prec > TCL_MAX_PREC) { return (char *) "improper value for precision"; } *precisionPtr = (int)prec; return NULL; } #endif /* !TCL_NO_DEPRECATED)*/ /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
718 719 720 721 722 723 724 | /* * An indexed local variable. */ Tcl_Obj *cachedNamePtr = localName(varFramePtr, index); if (part1Ptr == cachedNamePtr) { | | > > > > > > > > < | 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 | /* * An indexed local variable. */ Tcl_Obj *cachedNamePtr = localName(varFramePtr, index); if (part1Ptr == cachedNamePtr) { LocalSetIntRep(part1Ptr, index, NULL); } else { /* * [80304238ac] Trickiness here. We will store and incr the * refcount on cachedNamePtr. Trouble is that it's possible * (see test var-22.1) for cachedNamePtr to have an intrep * that contains a stored and refcounted part1Ptr. This * would be a reference cycle which leads to a memory leak. * * The solution here is to wipe away all intrep(s) in * cachedNamePtr and leave it as string only. This is * radical and destructive, so a better idea would be welcome. */ /* * Firstly set cached local var reference (avoid free before set, * see [45b9faf103f2]) */ LocalSetIntRep(part1Ptr, index, cachedNamePtr); /* Then wipe it */ TclFreeIntRep(cachedNamePtr); /* * Now go ahead and convert it the the "localVarName" type, * since we suspect at least some use of the value as a * varname and we want to resolve it quickly. */ LocalSetIntRep(cachedNamePtr, index, NULL); } } else { /* * At least mark part1Ptr as already parsed. */ ParsedSetIntRep(part1Ptr, NULL, NULL); } |
︙ | ︙ |
Changes to generic/tclZlib.c.
︙ | ︙ | |||
418 419 420 421 422 423 424 425 426 427 428 429 430 431 | * parsed. */ GzipHeader *headerPtr, /* Where to store the parsed-out values. */ int *extraSizePtr) /* Variable to add the length of header * strings (filename, comment) to. */ { Tcl_Obj *value; int len, result = TCL_ERROR; const char *valueStr; Tcl_Encoding latin1enc; static const char *const types[] = { "binary", "text" }; /* | > | 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 | * parsed. */ GzipHeader *headerPtr, /* Where to store the parsed-out values. */ int *extraSizePtr) /* Variable to add the length of header * strings (filename, comment) to. */ { Tcl_Obj *value; int len, result = TCL_ERROR; Tcl_WideInt wideValue = 0; const char *valueStr; Tcl_Encoding latin1enc; static const char *const types[] = { "binary", "text" }; /* |
︙ | ︙ | |||
481 482 483 484 485 486 487 | /* * Ignore the 'size' field, since that is controlled by the size of the * input data. */ if (GetValue(interp, dictObj, "time", &value) != TCL_OK) { goto error; | | | > | 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 | /* * Ignore the 'size' field, since that is controlled by the size of the * input data. */ if (GetValue(interp, dictObj, "time", &value) != TCL_OK) { goto error; } 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; } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types, "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) { goto error; } |
︙ | ︙ |
Changes to libtommath/bn_mp_clear.c.
︙ | ︙ | |||
21 22 23 24 25 26 27 | if (a->dp != NULL) { /* first zero the digits */ for (i = 0; i < a->used; i++) { a->dp[i] = 0; } /* free ram */ | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | if (a->dp != NULL) { /* first zero the digits */ for (i = 0; i < a->used; i++) { a->dp[i] = 0; } /* free ram */ XFREE(a->dp, sizeof (mp_digit) * (size_t)a->alloc); /* reset members to make debugging easier */ a->dp = NULL; a->alloc = a->used = 0; a->sign = MP_ZPOS; } } |
︙ | ︙ |
Changes to libtommath/bn_mp_fwrite.c.
︙ | ︙ | |||
18 19 20 21 22 23 24 | char *buf; int err, len, x; if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) { return err; } | | | | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | char *buf; int err, len, x; if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) { return err; } buf = (char *) XMALLOC((size_t)len); if (buf == NULL) { return MP_MEM; } if ((err = mp_toradix(a, buf, radix)) != MP_OKAY) { XFREE(buf, len); return err; } for (x = 0; x < len; x++) { if (fputc((int)buf[x], stream) == EOF) { XFREE(buf, len); return MP_VAL; } } XFREE(buf, len); return MP_OKAY; } #endif #endif /* ref: $Format:%D$ */ |
︙ | ︙ |
Changes to libtommath/bn_mp_get_double.c.
︙ | ︙ | |||
15 16 17 18 19 20 21 | double mp_get_double(const mp_int *a) { int i; double d = 0.0, fac = 1.0; for (i = 0; i < DIGIT_BIT; ++i) { fac *= 2.0; } | | | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | double mp_get_double(const mp_int *a) { int i; double d = 0.0, fac = 1.0; for (i = 0; i < DIGIT_BIT; ++i) { fac *= 2.0; } for (i = a->used; i --> 0;) { d = (d * fac) + (double)a->dp[i]; } return (a->sign == MP_NEG) ? -d : d; } #endif /* ref: $Format:%D$ */ /* git commit: $Format:%H$ */ /* commit time: $Format:%ai$ */ |
Changes to libtommath/bn_mp_get_long.c.
︙ | ︙ | |||
14 15 16 17 18 19 20 | /* get the lower unsigned long of an mp_int, platform dependent */ unsigned long mp_get_long(const mp_int *a) { int i; unsigned long res; | | | | | | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | /* get the lower unsigned long of an mp_int, platform dependent */ unsigned long mp_get_long(const mp_int *a) { int i; unsigned long res; if (IS_ZERO(a)) { return 0; } /* get number of digits of the lsb we have to read */ i = MIN(a->used, (((CHAR_BIT * (int)sizeof(unsigned long)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1; /* get most significant digit of result */ res = (unsigned long)a->dp[i]; #if (ULONG_MAX != 0xFFFFFFFFUL) || (DIGIT_BIT < 32) while (--i >= 0) { res = (res << DIGIT_BIT) | (unsigned long)a->dp[i]; } #endif return res; } #endif /* ref: $Format:%D$ */ |
︙ | ︙ |
Changes to libtommath/bn_mp_get_long_long.c.
︙ | ︙ | |||
14 15 16 17 18 19 20 | /* get the lower unsigned long long of an mp_int, platform dependent */ Tcl_WideUInt mp_get_long_long(const mp_int *a) { int i; Tcl_WideUInt res; | | | | | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | /* get the lower unsigned long long of an mp_int, platform dependent */ Tcl_WideUInt mp_get_long_long(const mp_int *a) { int i; Tcl_WideUInt res; if (IS_ZERO(a)) { return 0; } /* get number of digits of the lsb we have to read */ i = MIN(a->used, (((CHAR_BIT * (int)sizeof(Tcl_WideUInt)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1; /* get most significant digit of result */ res = (unsigned long long)a->dp[i]; #if DIGIT_BIT < 64 while (--i >= 0) { res = (res << DIGIT_BIT) | (unsigned long long)a->dp[i]; } #endif return res; } #endif /* ref: $Format:%D$ */ |
︙ | ︙ |
Changes to libtommath/bn_mp_grow.c.
︙ | ︙ | |||
25 26 27 28 29 30 31 | /* reallocate the array a->dp * * We store the return in a temporary variable * in case the operation failed we don't want * to overwrite the dp member of a. */ | | > > | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | /* reallocate the array a->dp * * We store the return in a temporary variable * in case the operation failed we don't want * to overwrite the dp member of a. */ tmp = (mp_digit *) XREALLOC(a->dp, (size_t)a->alloc * sizeof (mp_digit), (size_t)size * sizeof(mp_digit)); if (tmp == NULL) { /* reallocation failed but "a" is still valid [can be freed] */ return MP_MEM; } /* reallocation succeeded so set a->dp */ a->dp = tmp; |
︙ | ︙ |
Changes to libtommath/bn_mp_init.c.
︙ | ︙ | |||
14 15 16 17 18 19 20 | /* init a new mp_int */ int mp_init(mp_int *a) { int i; /* allocate memory required and clear it */ | | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | /* init a new mp_int */ int mp_init(mp_int *a) { int i; /* allocate memory required and clear it */ a->dp = (mp_digit *) XMALLOC(MP_PREC * sizeof(mp_digit)); if (a->dp == NULL) { return MP_MEM; } /* set the digits to zero */ for (i = 0; i < MP_PREC; i++) { a->dp[i] = 0; |
︙ | ︙ |
Changes to libtommath/bn_mp_init_size.c.
︙ | ︙ | |||
17 18 19 20 21 22 23 | { int x; /* pad size so there are always extra digits */ size += (MP_PREC * 2) - (size % MP_PREC); /* alloc mem */ | | | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | { int x; /* pad size so there are always extra digits */ size += (MP_PREC * 2) - (size % MP_PREC); /* alloc mem */ a->dp = (mp_digit *) XMALLOC((size_t)size * sizeof(mp_digit)); if (a->dp == NULL) { return MP_MEM; } /* set the members */ a->used = 0; a->alloc = size; |
︙ | ︙ |
Changes to libtommath/bn_mp_is_square.c.
︙ | ︙ | |||
45 46 47 48 49 50 51 | /* Default to Non-square :) */ *ret = MP_NO; if (arg->sign == MP_NEG) { return MP_VAL; } | < | | | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | /* Default to Non-square :) */ *ret = MP_NO; if (arg->sign == MP_NEG) { return MP_VAL; } if (IS_ZERO(arg)) { return MP_OKAY; } /* First check mod 128 (suppose that DIGIT_BIT is at least 7) */ if (rem_128[127u & arg->dp[0]] == (char)1) { return MP_OKAY; } /* Next check mod 105 (3*5*7) */ if ((res = mp_mod_d(arg, 105uL, &c)) != MP_OKAY) { return res; } |
︙ | ︙ |
Changes to libtommath/bn_mp_prime_random_ex.c.
︙ | ︙ | |||
42 43 44 45 46 47 48 | flags |= LTM_PRIME_BBS; } /* calc the byte size */ bsize = (size>>3) + ((size&7)?1:0); /* we need a buffer of bsize bytes */ | | | | | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 | flags |= LTM_PRIME_BBS; } /* calc the byte size */ bsize = (size>>3) + ((size&7)?1:0); /* we need a buffer of bsize bytes */ tmp = (unsigned char *) XMALLOC((size_t)bsize); if (tmp == NULL) { return MP_MEM; } /* calc the maskAND value for the MSbyte*/ maskAND = ((size&7) == 0) ? 0xFF : (unsigned char)(0xFF >> (8 - (size & 7))); /* calc the maskOR_msb */ maskOR_msb = 0; maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0; if ((flags & LTM_PRIME_2MSB_ON) != 0) { maskOR_msb |= (unsigned char)(0x80 >> ((9 - size) & 7)); } /* get the maskOR_lsb */ maskOR_lsb = 1; if ((flags & LTM_PRIME_BBS) != 0) { maskOR_lsb |= 3; } do { /* read the bytes */ if (cb(tmp, bsize, dat) != bsize) { err = MP_VAL; goto error; } /* work over the MSbyte */ tmp[0] &= maskAND; tmp[0] |= (unsigned char)(1 << ((size - 1) & 7)); /* mix in the maskORs */ tmp[maskOR_msb_offset] |= maskOR_msb; tmp[bsize-1] |= maskOR_lsb; /* read it in */ if ((err = mp_read_unsigned_bin(a, tmp, bsize)) != MP_OKAY) { |
︙ | ︙ | |||
119 120 121 122 123 124 125 | if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) { goto error; } } err = MP_OKAY; error: | | | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) { goto error; } } err = MP_OKAY; error: XFREE(tmp, bsize); return err; } #endif /* ref: $Format:%D$ */ /* git commit: $Format:%H$ */ /* commit time: $Format:%ai$ */ |
Changes to libtommath/bn_mp_read_radix.c.
︙ | ︙ | |||
8 9 10 11 12 13 14 15 16 17 18 19 20 21 | * The library was designed directly after the MPI library by * Michael Fromberger but has been written from scratch with * additional optimizations in place. * * SPDX-License-Identifier: Unlicense */ /* read a string [ASCII] in a given radix */ int mp_read_radix(mp_int *a, const char *str, int radix) { int y, res, neg; unsigned pos; char ch; | > > | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | * The library was designed directly after the MPI library by * Michael Fromberger but has been written from scratch with * additional optimizations in place. * * SPDX-License-Identifier: Unlicense */ #define MP_TOUPPER(c) ((((c) >= 'a') && ((c) <= 'z')) ? (((c) + 'A') - 'a') : (c)) /* read a string [ASCII] in a given radix */ int mp_read_radix(mp_int *a, const char *str, int radix) { int y, res, neg; unsigned pos; char ch; |
︙ | ︙ | |||
42 43 44 45 46 47 48 | /* process each digit of the string */ while (*str != '\0') { /* if the radix <= 36 the conversion is case insensitive * this allows numbers like 1AB and 1ab to represent the same value * [e.g. in hex] */ | | | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | /* process each digit of the string */ while (*str != '\0') { /* if the radix <= 36 the conversion is case insensitive * this allows numbers like 1AB and 1ab to represent the same value * [e.g. in hex] */ ch = (radix <= 36) ? (char)MP_TOUPPER((int)*str) : *str; pos = (unsigned)(ch - '('); if (mp_s_rmap_reverse_sz < pos) { break; } y = (int)mp_s_rmap_reverse[pos]; /* if the char was found in the map |
︙ | ︙ |
Changes to libtommath/bn_mp_set_double.c.
︙ | ︙ | |||
11 12 13 14 15 16 17 | * * SPDX-License-Identifier: Unlicense */ #if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559) int mp_set_double(mp_int *a, double b) { | | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | * * SPDX-License-Identifier: Unlicense */ #if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559) int mp_set_double(mp_int *a, double b) { unsigned long long frac; int exp, res; union { double dbl; unsigned long long bits; } cast; cast.dbl = b; exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFU); frac = (cast.bits & ((1ULL << 52) - 1ULL)) | (1ULL << 52); if (exp == 0x7FF) { /* +-inf, NaN */ |
︙ | ︙ | |||
37 38 39 40 41 42 43 | } res = (exp < 0) ? mp_div_2d(a, -exp, a, NULL) : mp_mul_2d(a, exp, a); if (res != MP_OKAY) { return res; } | | | | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | } res = (exp < 0) ? mp_div_2d(a, -exp, a, NULL) : mp_mul_2d(a, exp, a); if (res != MP_OKAY) { return res; } if (((cast.bits >> 63) != 0ULL) && !IS_ZERO(a)) { a->sign = MP_NEG; } return MP_OKAY; } #else /* pragma message() not supported by several compilers (in mostly older but still used versions) */ # ifdef _MSC_VER |
︙ | ︙ |
Changes to libtommath/bn_mp_shrink.c.
︙ | ︙ | |||
19 20 21 22 23 24 25 | int used = 1; if (a->used > 0) { used = a->used; } if (a->alloc != used) { | | > > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | int used = 1; if (a->used > 0) { used = a->used; } if (a->alloc != used) { if ((tmp = (mp_digit *) XREALLOC(a->dp, (size_t)a->alloc * sizeof (mp_digit), (size_t)used * sizeof(mp_digit))) == NULL) { return MP_MEM; } a->dp = tmp; a->alloc = used; } return MP_OKAY; } |
︙ | ︙ |
Changes to libtommath/bn_mp_sqrt.c.
︙ | ︙ | |||
10 11 12 13 14 15 16 17 18 19 20 21 22 23 | * additional optimizations in place. * * 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; | > > > < > > > < < | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | * additional optimizations in place. * * SPDX-License-Identifier: Unlicense */ #ifndef NO_FLOATING_POINT #include <math.h> #if (DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024) #define NO_FLOATING_POINT #endif #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; #ifndef NO_FLOATING_POINT int i, j, k; volatile double d; mp_digit dig; #endif /* must be positive */ if (arg->sign == MP_NEG) { return MP_VAL; } /* easy out */ if (mp_iszero(arg) == MP_YES) { mp_zero(ret); return MP_OKAY; } #ifndef NO_FLOATING_POINT i = (arg->used / 2) - 1; j = 2 * i; if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) { return res; } if ((res = mp_init(&t2)) != MP_OKAY) { goto E2; } for (k = 0; k < i; ++k) { t1.dp[k] = (mp_digit) 0; } /* 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]); } |
︙ | ︙ | |||
92 93 94 95 96 97 98 | } else { t1.used = i+1; t1.dp[i] = ((mp_digit) d) - 1; } #else | | > | | > > > | > | | 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | } else { t1.used = i+1; t1.dp[i] = ((mp_digit) d) - 1; } #else if ((res = mp_init_copy(&t1, arg)) != MP_OKAY) { return res; } if ((res = mp_init(&t2)) != MP_OKAY) { goto E2; } /* First approx. (not very bad for large arg) */ mp_rshd(&t1, t1.used/2); #endif /* t1 > 0 */ if ((res = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) { goto E1; } |
︙ | ︙ |
Changes to libtommath/tommath_private.h.
︙ | ︙ | |||
9 10 11 12 13 14 15 | * * SPDX-License-Identifier: Unlicense */ #ifndef TOMMATH_PRIV_H_ #define TOMMATH_PRIV_H_ #include <tommath.h> | < < < < < < < < < < | | | | | | > > > > > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | * * SPDX-License-Identifier: Unlicense */ #ifndef TOMMATH_PRIV_H_ #define TOMMATH_PRIV_H_ #include <tommath.h> #ifndef MIN #define MIN(x, y) (((x) < (y)) ? (x) : (y)) #endif #ifndef MAX #define MAX(x, y) (((x) > (y)) ? (x) : (y)) #endif #ifdef __cplusplus extern "C" { #endif /* define heap macros */ #ifndef XMALLOC /* default to libc stuff */ # define XMALLOC(size) malloc(size) # define XFREE(mem, size) free(mem) # define XREALLOC(mem, oldsize, newsize) realloc(mem, newsize) #elif 0 /* prototypes for our heap functions */ extern void *XMALLOC(size_t size); extern void *XREALLOC(void *mem, size_t oldsize, size_t newsize); extern void XFREE(void *mem, size_t size); #endif /* you'll have to tune these... */ #define KARATSUBA_MUL_CUTOFF 80 /* Min. number of digits before Karatsuba multiplication is used. */ #define KARATSUBA_SQR_CUTOFF 120 /* Min. number of digits before Karatsuba squaring is used. */ #define TOOM_MUL_CUTOFF 350 /* no optimal values of these are known yet so set em high */ #define TOOM_SQR_CUTOFF 400 /* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */ #define MP_WARRAY (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1)) /* ---> Basic Manipulations <--- */ #define IS_ZERO(a) ((a)->used == 0) #define IS_EVEN(a) (((a)->used == 0) || (((a)->dp[0] & 1u) == 0u)) #define IS_ODD(a) (((a)->used > 0) && (((a)->dp[0] & 1u) == 1u)) /* lowlevel functions, do not call! */ int s_mp_add(const mp_int *a, const mp_int *b, mp_int *c); int s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c); #define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1) int fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); int s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); int fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs); |
︙ | ︙ | |||
81 82 83 84 85 86 87 | extern const char *const mp_s_rmap; extern const unsigned char mp_s_rmap_reverse[]; extern const size_t mp_s_rmap_reverse_sz; /* Fancy macro to set an MPI from another type. * There are several things assumed: | | | | < | < < < < | | | < < | < < > > | < < | | | < | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | extern const char *const mp_s_rmap; extern const unsigned char mp_s_rmap_reverse[]; extern const size_t mp_s_rmap_reverse_sz; /* Fancy macro to set an MPI from another type. * There are several things assumed: * x is the counter * a is the pointer to the MPI * b is the original value that should be set in the MPI. */ #define MP_SET_XLONG(func_name, type) \ int func_name (mp_int * a, type b) \ { \ int x = 0; \ int new_size = (((CHAR_BIT * sizeof(type)) + DIGIT_BIT) - 1) / DIGIT_BIT; \ int res = mp_grow(a, new_size); \ if (res == MP_OKAY) { \ mp_zero(a); \ while (b != 0u) { \ a->dp[x++] = ((mp_digit)b & MP_MASK); \ if ((CHAR_BIT * sizeof (b)) <= DIGIT_BIT) { break; } \ b >>= ((CHAR_BIT * sizeof (b)) <= DIGIT_BIT ? 0 : DIGIT_BIT); \ } \ a->used = x; \ } \ return res; \ } #ifdef __cplusplus } #endif #endif /* ref: $Format:%D$ */ /* git commit: $Format:%H$ */ /* commit time: $Format:%ai$ */ |
Changes to macosx/tclMacOSXFCmd.c.
︙ | ︙ | |||
188 189 190 191 192 193 194 | OSSwapBigToHostInt32(finder->creator)); break; case MACOSX_TYPE_ATTRIBUTE: *attributePtrPtr = NewOSTypeObj( OSSwapBigToHostInt32(finder->type)); break; case MACOSX_HIDDEN_ATTRIBUTE: | | | 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 | OSSwapBigToHostInt32(finder->creator)); break; case MACOSX_TYPE_ATTRIBUTE: *attributePtrPtr = NewOSTypeObj( OSSwapBigToHostInt32(finder->type)); break; case MACOSX_HIDDEN_ATTRIBUTE: *attributePtrPtr = Tcl_NewWideIntObj( (finder->fdFlags & kFinfoIsInvisible) != 0); break; case MACOSX_RSRCLENGTH_ATTRIBUTE: *attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize); break; } return TCL_OK; |
︙ | ︙ | |||
576 577 578 579 580 581 582 | OSType *osTypePtr) /* Place to store resulting OSType. */ { int result = TCL_OK; if (!TclHasIntRep(objPtr, &tclOSTypeType)) { result = SetOSTypeFromAny(interp, objPtr); } | | | 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 | OSType *osTypePtr) /* Place to store resulting OSType. */ { int result = TCL_OK; if (!TclHasIntRep(objPtr, &tclOSTypeType)) { result = SetOSTypeFromAny(interp, objPtr); } *osTypePtr = (OSType) objPtr->internalRep.wideValue; return result; } /* *---------------------------------------------------------------------- * * NewOSTypeObj -- |
︙ | ︙ | |||
605 606 607 608 609 610 611 | const OSType osType) /* OSType used to initialize the new * object. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); TclInvalidateStringRep(objPtr); | | | 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 | const OSType osType) /* OSType used to initialize the new * object. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); TclInvalidateStringRep(objPtr); objPtr->internalRep.wideValue = (Tcl_WideInt) osType; objPtr->typePtr = &tclOSTypeType; return objPtr; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
656 657 658 659 660 661 662 | memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); osType = (OSType) bytes[0] << 24 | (OSType) bytes[1] << 16 | (OSType) bytes[2] << 8 | (OSType) bytes[3]; TclFreeIntRep(objPtr); | | | 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 | memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); osType = (OSType) bytes[0] << 24 | (OSType) bytes[1] << 16 | (OSType) bytes[2] << 8 | (OSType) bytes[3]; TclFreeIntRep(objPtr); objPtr->internalRep.wideValue = (Tcl_WideInt) osType; objPtr->typePtr = &tclOSTypeType; } Tcl_DStringFree(&ds); Tcl_FreeEncoding(encoding); return result; } |
︙ | ︙ | |||
690 691 692 693 694 695 696 | static void UpdateStringOfOSType( register Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const int size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); | | | 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 | static void UpdateStringOfOSType( register Tcl_Obj *objPtr) /* OSType object whose string rep to * update. */ { const int size = TCL_UTF_MAX * 4; char *dst = Tcl_InitStringRep(objPtr, NULL, size); OSType osType = (OSType) objPtr->internalRep.wideValue; int written = 0; Tcl_Encoding encoding; char src[5]; TclOOM(dst, size); src[0] = (char) (osType >> 24); |
︙ | ︙ |
Changes to tests/cmdMZ.test.
︙ | ︙ | |||
311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 | # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq" split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e" } "a b qw\u5e4eN wq" # The tests for Tcl_StringObjCmd are in string.test # The tests for Tcl_SubstObjCmd are in subst.test # The tests for Tcl_SwitchObjCmd are in switch.test test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body { time } -returnCodes error -result {wrong # args: should be "time command ?count?"} test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body { time a b c } -returnCodes error -result {wrong # args: should be "time command ?count?"} test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} -body { time a b } -returnCodes error -result {expected integer but got "b"} test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} { time bogusCmd -12456 } {0 microseconds per iteration} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body { time {format 1} } -match regexp -result {^\d+ microseconds per iteration} test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} { | > > > > > > > > | | 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 | # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq" split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e" } "a b qw\u5e4eN wq" # The tests for Tcl_StringObjCmd are in string.test # The tests for Tcl_SubstObjCmd are in subst.test # The tests for Tcl_SwitchObjCmd are in switch.test # todo: rewrite this if monotonic clock is provided resp. command "after" # gets microsecond accuracy (RFE [fdfbd5e10] gets merged): proc _nrt_sleep {msec} { set usec [expr {$msec * 1000}] set stime [clock microseconds] while {abs([clock microseconds] - $stime) < $usec} {after 0} } test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body { time } -returnCodes error -result {wrong # args: should be "time command ?count?"} test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body { time a b c } -returnCodes error -result {wrong # args: should be "time command ?count?"} test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} -body { time a b } -returnCodes error -result {expected integer but got "b"} test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} { time bogusCmd -12456 } {0 microseconds per iteration} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body { time {format 1} } -match regexp -result {^\d+ microseconds per iteration} test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} { expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]} } 1 test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within |
︙ | ︙ | |||
356 357 358 359 360 361 362 | } {1 {expected integer but got "b"}} test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate -overhead b {} a b} msg] $msg } {1 {expected floating-point number but got "b"}} 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}} | | > > > | | | | | | | | | | | > > > > > > > > > > > > > > > > > | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 | } {1 {expected integer but got "b"}} test cmdMZ-6.3 {Tcl_TimeRateObjCmd: basic format of command} { list [catch {timerate -overhead b {} a b} msg] $msg } {1 {expected floating-point number but got "b"}} 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.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 {_nrt_sleep 0} 20] set m2 [timerate {_nrt_sleep 0.2} 20] list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ [expr {[lindex $m2 0] > 100}] \ [expr {[lindex $m1 2] > 1000}] \ [expr {[lindex $m2 2] < 1000}] \ [expr {[lindex $m1 4] > 50000}] \ [expr {[lindex $m2 4] < 50000}] \ [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 100}] \ [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 100}] } [lrepeat 9 1] test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { list [catch {timerate {error foo} 1} msg] $msg $::errorInfo } {1 foo {foo while executing "error foo" invoked from within "timerate {error foo} 1"}} test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} { set m1 [timerate {break}] list \ [expr {[lindex $m1 0] < 1000}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] > 1000}] \ [expr {[lindex $m1 6] < 10}] } {1 1 1 1} test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} { set m1 [timerate {} 1000 5]; # max-count wins set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins list [lindex $m1 2] [lindex $m2 2] } {5 1} test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} { set m1 [timerate -overhead 1e6 {_nrt_sleep 10} 100 1] list \ [expr {[lindex $m1 0] == 0.0}] \ [expr {[lindex $m1 2] == 1}] \ [expr {[lindex $m1 4] == 1000000}] \ [expr {[lindex $m1 6] <= 0.001}] } {1 1 1 1} test cmdMZ-try-1.0 { fix for issue 45b9faf103f2 [try] interaction with local variable names produces segmentation violation } -body { ::apply {{} { set cmd try $cmd { lindex 5 } on ok res {} set res }} } -result 5 # The tests for Tcl_WhileObjCmd are in while.test # cleanup cleanupTests } namespace delete ::tcl::test::cmdMZ return # Local Variables: # mode: tcl # End: |
Changes to tests/obj.test.
︙ | ︙ | |||
472 473 474 475 476 477 478 | test obj-26.1 {UpdateStringOfInt} testobj { set result "" lappend result [testintobj set 1 512] lappend result [testintobj mult10 1] lappend result [testintobj get 1] ;# must update string rep } {512 5120 5120} | | | | | | | | | | | | | | | | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | test obj-26.1 {UpdateStringOfInt} testobj { set result "" lappend result [testintobj set 1 512] lappend result [testintobj mult10 1] lappend result [testintobj get 1] ;# must update string rep } {512 5120 5120} test obj-27.1 {Tcl_NewWideObj} testobj { set result "" lappend result [testobj freeallvars] testintobj setmax 1 lappend result [testintobj ismax 1] lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 1 int 1} 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 setint 1 77] ;# makes existing obj int lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 77 int 2} 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 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_GetWideIntFromObj, existing int object} testobj { set result "" lappend result [testintobj setint 1 22] lappend result [testintobj mult10 1] ;# gets existingint rep } {22 220} test obj-29.2 {Tcl_GetWideIntFromObj, convert to int} testobj { set result "" 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_GetWideIntFromObj, error converting to int} testobj { set result "" lappend result [teststringobj set 1 abc] 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_GetWideIntFromObj, error converting from "empty string"} testobj { set result "" lappend result [testobj newobj 1] lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int lappend result $msg } {{} 1 {expected integer but got ""}} test obj-30.1 {Ref counting and object deletion, simple types} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 1024] |
︙ | ︙ |
Changes to tests/oo.test.
︙ | ︙ | |||
1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 | lappend result [C a] [C b] [C c] - oo::define B deletemethod b lappend result [C a] [C b] [C c] - oo::define B renamemethod a b lappend result [C a] [C b] [C c] - oo::define B deletemethod b c lappend result [C a] [C b] [C c] } -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c} test oo-11.1 {OO: cleanup} { oo::object create foo set result [list [catch {oo::object create foo} msg] $msg] lappend result [foo destroy] [oo::object create foo] [foo destroy] } {1 {can't create object "foo": command already exists with that name} {} ::foo {}} | > > > > > > > > > > > > > > > > > > > > > > > > | 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 | lappend result [C a] [C b] [C c] - oo::define B deletemethod b lappend result [C a] [C b] [C c] - oo::define B renamemethod a b lappend result [C a] [C b] [C c] - oo::define B deletemethod b c lappend result [C a] [C b] [C c] } -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c} test oo-10.4 {OO: invoke and modify} -setup { oo::class create A { method a {} {return A.a} method b {} {return A.b} method c {} {return A.c} } A create B oo::objdefine B { method a {} {return [next],B.a} method b {} {return [next],B.b} method c {} {return [next],B.c} } set result {} } -cleanup { A destroy } -body { lappend result [B a] [B b] [B c] - oo::objdefine B deletemethod b lappend result [B a] [B b] [B c] - oo::objdefine B renamemethod a b lappend result [B a] [B b] [B c] - oo::objdefine B deletemethod b c lappend result [B a] [B b] [B c] } -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c} test oo-11.1 {OO: cleanup} { oo::object create foo set result [list [catch {oo::object create foo} msg] $msg] lappend result [foo destroy] [oo::object create foo] [foo destroy] } {1 {can't create object "foo": command already exists with that name} {} ::foo {}} |
︙ | ︙ |
Changes to tests/socket.test.
︙ | ︙ | |||
125 126 127 128 129 130 131 | # additional [after]s in some tests that are not needed on systems that fail # immediately. set t1 [clock milliseconds] catch {socket 127.0.0.1 [randport]} set t2 [clock milliseconds] set lat2 [expr {($t2-$t1)*3}] | | | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | # additional [after]s in some tests that are not needed on systems that fail # immediately. set t1 [clock milliseconds] catch {socket 127.0.0.1 [randport]} set t2 [clock milliseconds] set lat2 [expr {($t2-$t1)*3}] # Use the maximum of the two latency calculations, but at least 200ms set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}] set latency [expr {$latency > 200 ? $latency : 200}] unset t1 t2 s1 s2 lat1 lat2 server # If remoteServerIP or remoteServerPort are not set, check in the environment # variables for externally set values. # if {![info exists remoteServerIP]} { |
︙ | ︙ | |||
668 669 670 671 672 673 674 | set s [socket -server accept 0] set sock "" } -body { set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]] vwait sock puts $s2 one flush $s2 | | | 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 | set s [socket -server accept 0] set sock "" } -body { set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]] vwait sock puts $s2 one flush $s2 after $latency {set x 1}; # Spurious failures in Travis CI, if we do [after idle] vwait x fconfigure $sock -blocking 0 set result a:[gets $sock] lappend result b:[gets $sock] fconfigure $sock -blocking 1 puts $s2 two flush $s2 |
︙ | ︙ |
Changes to tests/utf.test.
︙ | ︙ | |||
104 105 106 107 108 109 110 | test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars { testnumutfchars "" } {0} 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} { | | | | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | test utf-4.1 {Tcl_NumUtfChars: zero length} testnumutfchars { testnumutfchars "" } {0} 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\x4E"] } {7} test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC0\x80"] } {1} test utf-4.5 {Tcl_NumUtfChars: zero length, calc len} testnumutfchars { testnumutfchars "" 0 } {0} test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestring} { 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\x4E"] 10 } {7} test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xC0\x80"] 2 } {1} # Bug [2738427]: Tcl_NumUtfChars(...) no overflow check test utf-4.9 {Tcl_NumUtfChars: #u20AC, calc len, incomplete} {testnumutfchars testbytestring} { testnumutfchars [testbytestring "\xE2\x82\xAC"] 2 |
︙ | ︙ |
Changes to unix/tclUnixFCmd.c.
︙ | ︙ | |||
1495 1496 1497 1498 1499 1500 1501 | static int SetGroupAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New group for file. */ { | | | | 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 | static int SetGroupAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New group for file. */ { Tcl_WideInt gid; int result; const char *native; if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr = NULL; const char *string; string = TclGetString(attributePtr); native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); |
︙ | ︙ | |||
1561 1562 1563 1564 1565 1566 1567 | static int SetOwnerAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New owner for file. */ { | | | | 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 | static int SetOwnerAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* New owner for file. */ { Tcl_WideInt uid; int result; const char *native; if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; string = TclGetString(attributePtr); native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); |
︙ | ︙ | |||
1627 1628 1629 1630 1631 1632 1633 | static int SetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* The attribute to set. */ { | | | | | 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 | static int SetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ int objIndex, /* The index of the attribute. */ Tcl_Obj *fileName, /* The name of the file (UTF-8). */ Tcl_Obj *attributePtr) /* The attribute to set. */ { Tcl_WideInt mode; mode_t newMode; int result = TCL_ERROR; const char *native; const char *modeStringPtr = TclGetString(attributePtr); int scanned = TclParseAllWhiteSpace(modeStringPtr, -1); /* * First supply support for octal number format */ if ((modeStringPtr[scanned] == '0') && (modeStringPtr[scanned+1] >= '0') && (modeStringPtr[scanned+1] <= '7')) { /* Leading zero - attempt octal interpretation */ Tcl_Obj *modeObj; TclNewLiteralStringObj(modeObj, "0o"); Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1); result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode); Tcl_DecrRefCount(modeObj); } if (result == TCL_OK || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) { newMode = (mode_t) (mode & 0x00007FFF); } else { Tcl_StatBuf buf; /* * Try the forms "rwxrwxrwx" and "ugo=rwx" * |
︙ | ︙ | |||
2336 2337 2338 2339 2340 2341 2342 | ckfree(winPath); if (fileAttributes == -1) { StatError(interp, fileName); return TCL_ERROR; } | | | | 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 | ckfree(winPath); if (fileAttributes == -1) { StatError(interp, fileName); return TCL_ERROR; } *attributePtrPtr = Tcl_NewWideIntObj( (fileAttributes & attributeArray[objIndex]) != 0); return TCL_OK; } /* *--------------------------------------------------------------------------- * * SetUnixFileAttributes |
︙ | ︙ | |||
2436 2437 2438 2439 2440 2441 2442 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } | | | 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 | Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": %s", TclGetString(fileName), Tcl_PosixError(interp))); } return TCL_ERROR; } *attributePtrPtr = Tcl_NewWideIntObj((statBuf.st_flags & UF_IMMUTABLE) != 0); return TCL_OK; } /* *--------------------------------------------------------------------------- * * SetUnixFileAttributes |
︙ | ︙ |
Changes to win/tclWinFCmd.c.
︙ | ︙ | |||
1545 1546 1547 1548 1549 1550 1551 | */ attr = 0; } } } | | | 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 | */ attr = 0; } } } *attributePtrPtr = Tcl_NewWideIntObj(attr != 0); return TCL_OK; } /* *---------------------------------------------------------------------- * * ConvertFileNameFormat -- |
︙ | ︙ |