cpython.git - https://github.com/python/cpython.git

	Commit message (Expand)	Author	Age	Files	Lines
*	Patch # 1739906 by Christian Heimes -- add reduce to functools (importing	Guido van Rossum	2007-08-27	1	-0/+1

*	[Bug #1576241] Let functools.wraps work with built-in functions	Andrew M. Kuchling	2006-10-27	1	-1/+1

*	Typo fix	Andrew M. Kuchling	2006-10-26	1	-1/+1

*	Add functools.update_wrapper() and functools.wraps() as described in PEP 356	Nick Coghlan	2006-06-08	1	-18/+43

*	Whitespace normalization.	Tim Peters	2006-05-30	1	-1/+1

*	When adding a module like functools, it helps to let SVN know about the file.	Nick Coghlan	2006-05-29	1	-0/+26

cl_AppendFormatToObj( ch = 'd'; } } -#ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) { goto error; @@ -2220,12 +2207,11 @@ Tcl_AppendFormatToObj( if (w == (Tcl_WideInt) 0) { gotHash = 0; } -#endif - } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { + } else if (TclGetIntFromObj(NULL, segment, &l) != TCL_OK) { if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) { goto error; } else { - l = (long) w; + l = (int) w; } if (useShort) { s = (short) l; @@ -2234,8 +2220,8 @@ Tcl_AppendFormatToObj( gotHash = 0; } } else { - isNegative = (l < (long) 0); - if (l == (long) 0) { + isNegative = (l < (int) 0); + if (l == (int) 0) { gotHash = 0; } } @@ -2246,8 +2232,8 @@ Tcl_AppendFormatToObj( gotHash = 0; } } else { - isNegative = (l < (long) 0); - if (l == (long) 0) { + isNegative = (l < (int) 0); + if (l == (int) 0) { gotHash = 0; } } @@ -2294,10 +2280,8 @@ Tcl_AppendFormatToObj( if (useShort) { TclNewIntObj(pure, s); -#ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { TclNewIntObj(pure, w); -#endif } else if (useBig) { pure = Tcl_NewBignumObj(&big); } else { @@ -2382,7 +2366,6 @@ Tcl_AppendFormatToObj( numDigits++; us /= base; } -#ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { Tcl_WideUInt uw = (Tcl_WideUInt) w; @@ -2391,7 +2374,6 @@ Tcl_AppendFormatToObj( numDigits++; uw /= base; } -#endif } else if (useBig && !mp_iszero(&big)) { int leftover = (big.used * MP_DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); @@ -2408,7 +2390,7 @@ Tcl_AppendFormatToObj( goto errorMsg; } } else if (!useBig) { - unsigned long ul = (unsigned long) l; + unsigned ul = (unsigned) l; bits = (Tcl_WideUInt) ul; while (ul) { diff --git a/tests/format.test b/tests/format.test index 5af6c19..39de907 100644 --- a/tests/format.test +++ b/tests/format.test @@ -15,10 +15,7 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -# %u output depends on word length, so this test is not portable. -testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] -testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] -testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] +# %z/%t/%p output depends on pointerSize, so some tests are not portable. testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] # MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain # particularly in Continuous Integration, and there isn't anything much we can @@ -31,12 +28,9 @@ test format-1.1 {integer formatting} { test format-1.2 {integer formatting} { format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12 } { 6 34 16923 -12 -1 0xe 0xC} -test format-1.3 {integer formatting} longIs32bit { +test format-1.3 {integer formatting} { format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0 } { 6 34 16923 4294967284 -1 0} -test format-1.3.1 {integer formatting} longIs64bit { - format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0 -} { 6 34 16923 18446744073709551604 -1 0} test format-1.4 {integer formatting} { format "%-4d %-4i %-4d %-4ld" 6 34 16923 -12 -1 } {6 34 16923 -12 } @@ -48,36 +42,21 @@ test format-1.6 {integer formatting} { } {000034} # Printing negative numbers in hex or octal format depends on word # length, so these tests are not portable. -test format-1.7 {integer formatting} longIs32bit { +test format-1.7 {integer formatting} { format "%4x %4x %4x %4x" 6 34 16923 -12 -1 } { 6 22 421b fffffff4} -test format-1.7.1 {integer formatting} longIs64bit { - format "%4x %4x %4x %4x" 6 34 16923 -12 -1 -} { 6 22 421b fffffffffffffff4} -test format-1.8 {integer formatting} longIs32bit { +test format-1.8 {integer formatting} { format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 } {0 0x6 0x22 0x421B 0xfffffff4} -test format-1.8.1 {integer formatting} longIs64bit { - format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 -} {0 0x6 0x22 0x421B 0xfffffffffffffff4} -test format-1.9 {integer formatting} longIs32bit { +test format-1.9 {integer formatting} { format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 } { 0 0x6 0x22 0x421b 0xfffffff4} -test format-1.9.1 {integer formatting} longIs64bit { - format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 -} { 0 0x6 0x22 0x421b 0xfffffffffffffff4} -test format-1.10 {integer formatting} longIs32bit { +test format-1.10 {integer formatting} { format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 } {0 0x6 0x22 0x421b 0xfffffff4 } -test format-1.10.1 {integer formatting} longIs64bit { - format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 -} {0 0x6 0x22 0x421b 0xfffffffffffffff4 } -test format-1.11 {integer formatting} longIs32bit { +test format-1.11 {integer formatting} { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 } {0 0o6 0o42 0o41033 0o37777777764 } -test format-1.11.1 {integer formatting} longIs64bit { - format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 -} {0 0o6 0o42 0o41033 0o1777777777777777777764} test format-1.12 {integer formatting} { format "%b %#b %#b %llb" 5 0 5 [expr {2**100}] } {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} @@ -556,13 +535,13 @@ for {set i 290} {$i < 400} {incr i} { append b "x" } -test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} { +test format-17.1 {testing %d with wide} { format %d 7810179016327718216 } 1819043144 -test format-17.2 {testing %ld with wide} {wideIs64bit} { +test format-17.2 {testing %ld with wide} { format %ld 7810179016327718216 } 7810179016327718216 -test format-17.3 {testing %ld with non-wide} {wideIs64bit} { +test format-17.3 {testing %ld with non-wide} { format %ld 42 } 42 test format-17.4 {testing %l with non-integer} { @@ -589,7 +568,7 @@ test format-18.1 {do not demote existing numeric values} { format %08x $b lappend result [expr {$a == $b}] } {1 1 1 1} -test format-18.2 {do not demote existing numeric values} {longIs32bit wideIs64bit} { +test format-18.2 {do not demote existing numeric values} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] @@ -606,8 +585,7 @@ test format-19.3 {Bug 2830354} { string length [format %340f 0] } 340 -test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} \ --constraints {longIs32bit} -body { +test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} -body { # in case of overflow into negative, it produces width -2 (and limit exceeded), # in case of width will be unsigned, it will be outside limit (2GB for 32bit)... # and it don't throw an error in case the bug is not fixed (and probably no segfault). -- cgit v0.12 From 04696b538d50c932db9d41367cc26ca0ec850ac5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 31 May 2024 13:21:27 +0000 Subject: Make last test-cases pass --- generic/tclScan.c | 16 ++-------------- tests/expr.test | 2 +- tests/obj.test | 11 +++++------ tests/scan.test | 3 +-- 4 files changed, 9 insertions(+), 23 deletions(-) diff --git a/generic/tclScan.c b/generic/tclScan.c index ca27f77..e4511bf 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -605,7 +605,7 @@ Tcl_ScanObjCmd( const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; - long value; + int value; const char *string, *end, *baseString; char op = 0; int underflow = 0; @@ -1006,19 +1006,7 @@ Tcl_ScanObjCmd( } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { -#ifdef TCL_WIDE_INT_IS_LONG - mp_int big; - if (mp_init_u64(&big, (unsigned long)value) != MP_OKAY) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to create bignum", -1)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); - return TCL_ERROR; - } else { - Tcl_SetBignumObj(objPtr, &big); - } -#else - Tcl_SetWideIntObj(objPtr, (unsigned long)value); -#endif + Tcl_SetWideIntObj(objPtr, (unsigned int)value); } else { TclSetIntObj(objPtr, value); } diff --git a/tests/expr.test b/tests/expr.test index f2c7ae6..bfefde3 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -5842,7 +5842,7 @@ test expr-33.1 {parse largest long value} { [expr {int(2147483647 + 1) > 0}] \ } {2147483647 2147483647 2147483647 2147483647 1 1} -test expr-33.2 {parse smallest long value} longIs32bit { +test expr-33.2 {parse smallest long value} { set min_long_str -2147483648 set min_long_hex "-0x80000000 " diff --git a/tests/obj.test b/tests/obj.test index eb85c84..fcd8d89 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -20,7 +20,6 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] -testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { @@ -547,11 +546,11 @@ test obj-32.1 {freeing very large object trees} { unset x } {} -test obj-33.1 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.1 {integer overflow on input} {wideIs64bit} { set x 0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 2147483648} -test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.2 {integer overflow on input} {wideIs64bit} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} @@ -559,15 +558,15 @@ test obj-33.3 {integer overflow on input} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 4294967296} -test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.4 {integer overflow on input} {wideIs64bit} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -2147483648} -test obj-33.5 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.5 {integer overflow on input} {wideIs64bit} { set x -0x8000; append x 0001 list [string is integer $x] [expr { wide($x) }] } {1 -2147483649} -test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.6 {integer overflow on input} {wideIs64bit} { set x -0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 -4294967295} diff --git a/tests/scan.test b/tests/scan.test index 6d7a9fb..6d91c8d 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -82,7 +82,6 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] -testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x @@ -517,7 +516,7 @@ test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] } -result {2 4294967280 1} -test scan-5.12 {integer scanning} -constraints {wideIs64bit} -setup { +test scan-5.12 {integer scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ -- cgit v0.12 From 4fa54adbdec030bc26298f5f38d4435b4c1818b5 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 4 Jun 2024 16:39:14 +0000 Subject: TIP 696 #defines and docs --- doc/CrtCommand.3 | 9 ++++++--- doc/CrtObjCmd.3 | 7 ++++--- doc/catch.n | 10 ++++++---- doc/return.n | 5 ++++- generic/tcl.h | 5 +++++ 5 files changed, 25 insertions(+), 11 deletions(-) diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3 index d15a920..5d25667 100644 --- a/doc/CrtCommand.3 +++ b/doc/CrtCommand.3 @@ -102,9 +102,12 @@ version 8.1 of Tcl. .PP \fIProc\fR must return an integer code that is expected to be one of \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or -\fBTCL_CONTINUE\fR. See the Tcl overview man page -for details on what these codes mean. Most normal commands will only -return \fBTCL_OK\fR or \fBTCL_ERROR\fR. In addition, \fIproc\fR must set +\fBTCL_CONTINUE\fR. See the \fBreturn\fR man page for details on +what these codes mean and the use of extended values for an extension's +private use. Most normal commands will only return \fBTCL_OK\fR +or \fBTCL_ERROR\fR. +.PP +In addition, \fIproc\fR must set the interpreter result; in the case of a \fBTCL_OK\fR return code this gives the result of the command, and in the case of \fBTCL_ERROR\fR it gives an error message. diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 522f903..b28d901 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -132,9 +132,10 @@ that \fIobjv\fR[\fB2\fR] points at, but will not change where .PP \fIproc\fR must return an integer code that is either \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. -See the Tcl overview man page -for details on what these codes mean. Most normal commands will only -return \fBTCL_OK\fR or \fBTCL_ERROR\fR. +See the \fBreturn\fR man page for details on what these codes mean and the +use of extended values for an extension's private use. Most normal commands +will only return \fBTCL_OK\fR or \fBTCL_ERROR\fR. +.PP In addition, if \fIproc\fR needs to return a non-empty result, it can call \fBTcl_SetObjResult\fR to set the interpreter's result. In the case of a \fBTCL_OK\fR return code this gives the result diff --git a/doc/catch.n b/doc/catch.n index 8d885d4..0a2c513 100644 --- a/doc/catch.n +++ b/doc/catch.n @@ -30,10 +30,12 @@ return codes: 1 (\fBTCL_ERROR\fR), 2 (\fBTCL_RETURN\fR), 3 (\fBTCL_BREAK\fR), and 4 (\fBTCL_CONTINUE\fR). Errors during evaluation of a script are indicated by a return code of \fBTCL_ERROR\fR. The other exceptional return codes are returned by the \fBreturn\fR, \fBbreak\fR, and \fBcontinue\fR commands -and in other special situations as documented. Tcl packages can define -new commands that return other integer values as return codes as well, -and scripts that make use of the \fBreturn \-code\fR command can also -have return codes other than the five defined by Tcl. +and in other special situations as documented. +New commands defined by Tcl packages as well as scripts that make +use of the \fBreturn \-code\fR command can return other integer +values as the return code. These must however lie outside the range +reserved for Tcl as documented for the \fBreturn\fR command. + .PP If the \fIresultVarName\fR argument is given, then the variable it names is set to the result of the script evaluation. When the return code from the diff --git a/doc/return.n b/doc/return.n index 9bf1ae2..6c5b821 100644 --- a/doc/return.n +++ b/doc/return.n @@ -78,7 +78,10 @@ were the command \fBcontinue\fR. \fIvalue\fR . \fIValue\fR must be an integer; it will be returned as the -return code for the current procedure. +return code for the current procedure. Values in the range +-0x40000000 (-1073741824) to 0x40000000 (1073741824) are reserved +for Tcl. Applications and extensions should use codes outside +this range. .LP When a procedure wants to signal that it has received invalid arguments from its caller, it may use \fBreturn -code error\fR diff --git a/generic/tcl.h b/generic/tcl.h index 41e68a8..183d2ca 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -515,6 +515,9 @@ typedef struct stat *Tcl_OldStat_; * exited; the interpreter's result is meaningless. * TCL_CONTINUE Go on to the next iteration of the current loop; the * interpreter's result is meaningless. + * Integer return codes in the range TCL_CODE_MIN to TCL_CODE_MAX are + * reserved for the use of Tcl. Extensions and packages are free to use + * values outside this range for their own purposes. */ #define TCL_OK 0 @@ -522,6 +525,8 @@ typedef struct stat *Tcl_OldStat_; #define TCL_RETURN 2 #define TCL_BREAK 3 #define TCL_CONTINUE 4 +#define TCL_CODE_MAX 0x40000000 +#define TCL_CODE_MIN (-TCL_CODE_MAX) /* *---------------------------------------------------------------------------- -- cgit v0.12 From 5b8c3257ff518c67cc7dc645c47804f3f7f23980 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sun, 9 Jun 2024 16:35:47 +0000 Subject: Update to new TIP revision --- doc/return.n | 8 ++++---- generic/tcl.h | 9 ++++----- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/doc/return.n b/doc/return.n index 6c5b821..52c1676 100644 --- a/doc/return.n +++ b/doc/return.n @@ -78,10 +78,10 @@ were the command \fBcontinue\fR. \fIvalue\fR . \fIValue\fR must be an integer; it will be returned as the -return code for the current procedure. Values in the range --0x40000000 (-1073741824) to 0x40000000 (1073741824) are reserved -for Tcl. Applications and extensions should use codes outside -this range. +return code for the current procedure. Applications +and packages should use values in the range 5 to 268435455 (0x3fffffff) +for their own purposes. Values outside this range are reserved +for use by Tcl. .LP When a procedure wants to signal that it has received invalid arguments from its caller, it may use \fBreturn -code error\fR diff --git a/generic/tcl.h b/generic/tcl.h index 183d2ca..f20a4d4 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -515,9 +515,8 @@ typedef struct stat *Tcl_OldStat_; * exited; the interpreter's result is meaningless. * TCL_