summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog24
-rw-r--r--generic/tclMain.c6
-rwxr-xr-xgeneric/tclStrToD.c12
-rw-r--r--tests/binary.test17
-rw-r--r--tests/http.test19
-rw-r--r--tests/scan.test4
-rw-r--r--unix/tclUnixSock.c8
7 files changed, 64 insertions, 26 deletions
diff --git a/ChangeLog b/ChangeLog
index 746955a..5eed2d9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2011-09-06 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.h: [RFE 1711975]: Tcl_MainEx() (like Tk_MainEx())
+ * generic/tclDecls.h
+ * generic/tclMain.c
+
+2011-09-02 Don Porter <dgp@users.sourceforge.net>
+
+ * tests/http.test: Convert [testthread] use to Thread package use.
+ Eliminates memory leak seen in `make valgrind`.
+
+2011-09-01 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+
+ * unix/tclUnixSock.c: [Bug 3401422] Cache script-level changes to
+ the nonblocking flag of an async client socket in progress, and
+ commit them on completion.
+
+2011-09-01 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclStrToD.c: [Bug 3402540] Corrections to TclParseNumber()
+ * tests/binary.test: to make it reject invalid Nan(Hex) strings.
+
+ * tests/scan.test: [scan Inf %g] is portable; remove constraint.
+
2011-08-30 Donal K. Fellows <dkf@users.sf.net>
* generic/tclInterp.c (SlaveCommandLimitCmd, SlaveTimeLimitCmd):
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 58ad377..373e3f6 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -620,19 +620,19 @@ Tcl_MainEx(
Tcl_Exit(exitCode);
}
-#ifndef UNICODE
+#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE)
#undef Tcl_Main
extern DLLEXPORT void
Tcl_Main(
int argc, /* Number of arguments. */
- TCHAR **argv, /* Array of argument strings. */
+ char **argv, /* Array of argument strings. */
Tcl_AppInitProc *appInitProc)
/* Application-specific initialization
* function to call after most initialization
* but before starting to execute commands. */
{
Tcl_FindExecutable(argv[0]);
- Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
+ Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
}
#endif
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index a55ee83..332cfca 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -249,15 +249,6 @@ static const int itens [] = {
100000000
};
-static const Tcl_WideUInt wtens[] = {
- 1, 10, 100, 1000, 10000, 100000, 1000000,
- (Tcl_WideUInt) 1000000*10, (Tcl_WideUInt) 1000000*100,
- (Tcl_WideUInt) 1000000*1000, (Tcl_WideUInt) 1000000*10000,
- (Tcl_WideUInt) 1000000*100000, (Tcl_WideUInt) 1000000*1000000,
- (Tcl_WideUInt) 1000000*1000000*10, (Tcl_WideUInt) 1000000*1000000*100,
- (Tcl_WideUInt) 1000000*1000000*1000,(Tcl_WideUInt) 1000000*1000000*10000
-};
-
static const double bigtens[] = {
1e016, 1e032, 1e064, 1e128, 1e256
};
@@ -1101,7 +1092,10 @@ TclParseNumber(
d = 10 + c - 'a';
} else if (c >= 'A' && c <= 'F') {
d = 10 + c - 'A';
+ } else {
+ goto endgame;
}
+ numSigDigs++;
significandWide = (significandWide << 4) + d;
state = sNANHEX;
break;
diff --git a/tests/binary.test b/tests/binary.test
index 8b2880b..6c00508 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -2381,6 +2381,23 @@ test binary-63.4 {NaN} ieeeFloatingPoint {
format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
} 0x7ff3123456789abc
+# Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540]
+test binary-63.5 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan(
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.6 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan()
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.7 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan(g)
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.8 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan(1,2)
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.9 {NaN} -constraints ieeeFloatingPoint -body {
+ binary format q Nan(1234567890abcd)
+} -returnCodes error -match glob -result {expected floating-point number*}
+
test binary-64.1 {NaN} -constraints ieeeFloatingPoint -body {
binary scan [binary format w 0x7ff8000000000000] q d
set d
diff --git a/tests/http.test b/tests/http.test
index 1f4d8b4..e6e7649 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -51,14 +51,13 @@ if {![file exists $httpdFile]} {
set removeHttpd 1
}
-if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
- set httpthread [testthread create "
- source [list $httpdFile]
- testthread wait
- "]
- testthread send $httpthread [list set port $port]
- testthread send $httpthread [list set bindata $bindata]
- testthread send $httpthread {httpd_init $port}
+catch {package require Thread 2.6}
+if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
+ set httpthread [thread::create -preserved]
+ thread::send $httpthread [list source $httpdFile]
+ thread::send $httpthread [list set port $port]
+ thread::send $httpthread [list set bindata $bindata]
+ thread::send $httpthread {httpd_init $port}
puts "Running httpd in thread $httpthread"
} else {
if {![file exists $httpdFile]} {
@@ -590,9 +589,7 @@ catch {unset badurl}
catch {unset port}
catch {unset data}
if {[info exists httpthread]} {
- testthread send -async $httpthread {
- testthread exit
- }
+ thread::release $httpthread
} else {
close $listen
}
diff --git a/tests/scan.test b/tests/scan.test
index 84f22b4..97ad5eb 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -753,11 +753,11 @@ testConstraint ieeeFloatingPoint [testIEEE]
# scan infinities - not working
-test scan-14.1 {infinity} ieeeFloatingPoint {
+test scan-14.1 {infinity} {
scan Inf %g d
set d
} Inf
-test scan-14.2 {infinity} ieeeFloatingPoint {
+test scan-14.2 {infinity} {
scan -Inf %g d
set d
} -Inf
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 35c00c5..7b5c9e0 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -68,6 +68,7 @@ struct TcpState {
int filehandlers; /* Caches FileHandlers that get set up while
* an async socket is not yet connected */
int status; /* Cache status of async socket */
+ int cachedBlocking; /* Cache blocking mode of async socket */
};
/*
@@ -348,6 +349,10 @@ TcpBlockModeProc(
} else {
SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
}
+ if (statePtr->flags & TCP_ASYNC_CONNECT) {
+ statePtr->cachedBlocking = mode;
+ return 0;
+ }
if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) {
return errno;
}
@@ -1038,7 +1043,7 @@ out:
*/
CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT);
TcpWatchProc(state, state->filehandlers);
- TclUnixSetBlockingMode(state->fds.fd, TCL_MODE_BLOCKING);
+ TclUnixSetBlockingMode(state->fds.fd, state->cachedBlocking);
/*
* We need to forward the writable event that brought us here, bcasue
@@ -1122,6 +1127,7 @@ Tcl_OpenTcpClient(
state = ckalloc(sizeof(TcpState));
memset(state, 0, sizeof(TcpState));
state->flags = async ? TCP_ASYNC_CONNECT : 0;
+ state->cachedBlocking = TCL_MODE_BLOCKING;
state->addrlist = addrlist;
state->myaddrlist = myaddrlist;
state->fds.fd = -1;
generated by cgit v0.12 at 2024-07-16 00:45:45 (GMT)