summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog57
-rw-r--r--doc/switch.n11
-rw-r--r--generic/tclCmdMZ.c83
-rw-r--r--generic/tclCompCmds.c43
-rw-r--r--generic/tclEnv.c4
-rw-r--r--library/tcltest/pkgIndex.tcl2
-rw-r--r--library/tcltest/tcltest.tcl4
-rw-r--r--tests/switch.test367
-rw-r--r--unix/Makefile.in6
-rw-r--r--unix/tclUnixChan.c6
-rw-r--r--win/.cvsignore35
-rw-r--r--win/Makefile.in6
-rwxr-xr-xwin/configure10
-rw-r--r--win/makefile.vc4
-rw-r--r--win/tcl.m410
-rw-r--r--win/tclWinSock.c365
16 files changed, 441 insertions, 572 deletions
diff --git a/ChangeLog b/ChangeLog
index d3428d6..dccae1e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,46 @@
+2007-12-03 Donal K. Fellows <dkf@users.sf.net>
+
+ * unix/tclUnixChan.c (CreateSocketAddress): Add extra #ifdef-fery to
+ make code compile on BSD 5. [Bug 1618235, again]
+
+2007-12-03 Don Porter <dgp@users.sourceforge.net>
+
+ * library/tcltest/tcltest.tcl: Bump tcltest to version 2.3.0 so that
+ * library/tcltest/pkgIndex.tcl: we release a stable tcltest with a
+ * unix/Makefile.in: stable Tcl.
+ * win/Makefile.in:
+
+2007-12-03 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/configure, win/tcl.m4 (LIBS_GUI): remove ole32.lib oleaut32.lib
+
+2007-12-03 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclCompCmds.c (TclCompileSwitchCmd): Adjusted the [switch]
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd): command so that when
+ passed two arguments, no check for options are performed. This is OK
+ since in the two-arg case, detecting an option would definitely lead
+ to a syntax error. [Patch 1836519]
+
+2007-11-29 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * win/makefile.vc: add ws2_32.lib to baselibs
+ * win/configure, win/tcl.m4: add ws2_32.lib / -lws2_32 to build.
+ * win/tclWinSock.c: remove dyn loading of winsock, assume that it is
+ always available now.
+
+2007-11-29 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclWinSock.c (InitializeHostName): Correct error in
+ buffer length tracking. After gethostname() writes into a buffer,
+ convert only the written string to internal encoding, not the whole
+ buffer.
+
2007-11-28 Don Porter <dgp@users.sourceforge.net>
* generic/tclConfig.c: Corrected failure of the [::foo::pkgconfig]
command to clean up registered configuration data when the query
- command is deleted from the interp. [Bug 983501].
+ command is deleted from the interp. [Bug 983501]
* generic/tclNamesp.c (Tcl_SetEnsembleMappingDict): Added checks
that the dict value passed in is in the format required to make the
@@ -17,8 +55,8 @@
2007-11-27 Miguel Sofer <msofer@users.sf.net>
- * generic/tclBasic.c: remove unneeded call in Tcl_CreateInterp,
- add comments
+ * generic/tclBasic.c: remove unneeded call in Tcl_CreateInterp, add
+ comments.
2007-11-27 Don Porter <dgp@users.sourceforge.net>
@@ -27,9 +65,8 @@
* doc/chan.n: "Fix" the limitation on channel -eofchar
* doc/fconfigure.n: values to single byte characters by documenting
- * generic/tclIO.c: it and making it fail loudly. Thanks to
- * tests/chan.test: Stuart Cassoff for contributing the fix.
- [Bug 800753]
+ * generic/tclIO.c: it and making it fail loudly. Thanks to Stuart
+ * tests/chan.test: Cassoff for contributing the fix. [Bug 800753]
2007-11-26 Miguel Sofer <msofer@users.sf.net>
@@ -37,10 +74,10 @@
* generic/tclInt.h:
* unix/tclUnixInit.c:
* unix/tclUnixThrd.c: Fix stack checking via workaround for bug in
- glibc's pthread_attr_get_np, patch from [Bug 1815573]. Many thanks
- to Sergei Golovan (aka Teo) for detecting the bug and helping
- diagnose and develop the fix.
-
+ glibc's pthread_attr_get_np, patch from [Bug 1815573]. Many thanks to
+ Sergei Golovan (aka Teo) for detecting the bug and helping diagnose
+ and develop the fix.
+
2007-11-24 Donal K. Fellows <dkf@users.sf.net>
* generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix bug in [dict
diff --git a/doc/switch.n b/doc/switch.n
index 72c7b1e..7a6e5de 100644
--- a/doc/switch.n
+++ b/doc/switch.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: switch.n,v 1.10.6.1 2007/11/01 16:25:55 dgp Exp $
+'\" RCS: @(#) $Id: switch.n,v 1.10.6.2 2007/12/04 16:55:53 dgp Exp $
'\"
.so man.macros
.TH switch n 8.5 Tcl "Tcl Built-In Commands"
@@ -85,6 +85,10 @@ time as the \fB\-matchvar\fR option.
\fB\-\|\-\fR
Marks the end of options. The argument following this one will
be treated as \fIstring\fR even if it starts with a \fB\-\fR.
+.VS 8.5
+This is not required when the matching patterns and bodies are grouped
+together in a single argument.
+.VE 8.5
.PP
Two syntaxes are provided for the \fIpattern\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;
@@ -138,7 +142,7 @@ Whenever nothing matches, the \fBdefault\fR clause (which must be
last) is taken. This example has a result of \fI3\fR:
.CS
\fBswitch\fR xyz {
- a \-
+ a \-
b {
# Correct Comment Placement
expr {1}
@@ -171,3 +175,6 @@ exactly matched is easily obtained using the \fB\-matchvar\fR option:
for(n), if(n), regexp(n)
.SH KEYWORDS
switch, match, regular expression
+.\" Local Variables:
+.\" mode: nroff
+.\" End:
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 56ac530..c8a9cb2 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.9 2007/11/25 06:45:44 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.10 2007/12/04 16:55:53 dgp Exp $
*/
#include "tclInt.h"
@@ -3469,7 +3469,7 @@ Tcl_SwitchObjCmd(
matchVarObj = NULL;
numMatchesSaved = 0;
noCase = 0;
- for (i = 1; i < objc; i++) {
+ for (i = 1; i < objc-2; i++) {
if (TclGetString(objv[i])[0] != '-') {
break;
}
@@ -3477,40 +3477,24 @@ Tcl_SwitchObjCmd(
&index) != TCL_OK) {
return TCL_ERROR;
}
- if (index == OPT_LAST) {
- i++;
- break;
- }
-
- /*
- * Check for TIP#75 options specifying the variables to write regexp
- * information into.
- */
+ switch ((enum options) index) {
+ /*
+ * General options.
+ */
- if (index == OPT_INDEXV) {
+ case OPT_LAST:
i++;
- if (i == objc) {
- Tcl_AppendResult(interp,
- "missing variable name argument to -indexvar option",
- NULL);
- return TCL_ERROR;
- }
- indexVarObj = objv[i];
- numMatchesSaved = -1;
- } else if (index == OPT_MATCHV) {
- i++;
- if (i == objc) {
- Tcl_AppendResult(interp,
- "missing variable name argument to -matchvar option",
- NULL);
- return TCL_ERROR;
- }
- matchVarObj = objv[i];
- numMatchesSaved = -1;
- } else if (index == OPT_NOCASE) {
+ goto finishedOptions;
+ case OPT_NOCASE:
strCmpFn = strcasecmp;
noCase = 1;
- } else {
+ break;
+
+ /*
+ * Handle the different switch mode options.
+ */
+
+ default:
if (foundmode) {
/*
* Mode already set via -exact, -glob, or -regexp.
@@ -3520,12 +3504,41 @@ Tcl_SwitchObjCmd(
TclGetString(objv[i]), "\": ", options[mode],
" option already found", NULL);
return TCL_ERROR;
+ } else {
+ foundmode = 1;
+ mode = index;
+ break;
+ }
+
+ /*
+ * Check for TIP#75 options specifying the variables to write
+ * regexp information into.
+ */
+
+ case OPT_INDEXV:
+ i++;
+ if (i >= objc-2) {
+ Tcl_AppendResult(interp, "missing variable name argument to ",
+ "-indexvar", " option", NULL);
+ return TCL_ERROR;
}
- foundmode = 1;
- mode = index;
+ indexVarObj = objv[i];
+ numMatchesSaved = -1;
+ break;
+ case OPT_MATCHV:
+ i++;
+ if (i >= objc-2) {
+ Tcl_AppendResult(interp, "missing variable name argument to ",
+ "-matchvar", " option", NULL);
+ return TCL_ERROR;
+ }
+ matchVarObj = objv[i];
+ numMatchesSaved = -1;
+ break;
}
}
+ finishedOptions:
if (objc - i < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?switches? string pattern body ... ?default body?");
@@ -3545,7 +3558,7 @@ Tcl_SwitchObjCmd(
stringObj = objv[i];
objc -= i + 1;
objv += i + 1;
- bidx = i+1; /* First after the match string. */
+ bidx = i + 1; /* First after the match string. */
/*
* If all of the pattern/command pairs are lumped into a single argument,
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 4d01c44..dec56d2 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.13 2007/11/25 06:45:44 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.14 2007/12/04 16:55:53 dgp Exp $
*/
#include "tclInt.h"
@@ -3856,14 +3856,14 @@ TclCompileSwitchCmd(
/*
* Only handle the following versions:
- * switch -- word {pattern body ...}
- * switch -exact -- word {pattern body ...}
- * switch -glob -- word {pattern body ...}
- * switch -regexp -- word {pattern body ...}
- * switch -- word simpleWordPattern simpleWordBody ...
- * switch -exact -- word simpleWordPattern simpleWordBody ...
- * switch -glob -- word simpleWordPattern simpleWordBody ...
- * switch -regexp -- word simpleWordPattern simpleWordBody ...
+ * switch ?--? word {pattern body ...}
+ * switch -exact ?--? word {pattern body ...}
+ * switch -glob ?--? word {pattern body ...}
+ * switch -regexp ?--? word {pattern body ...}
+ * switch -- word simpleWordPattern simpleWordBody ...
+ * switch -exact -- word simpleWordPattern simpleWordBody ...
+ * switch -glob -- word simpleWordPattern simpleWordBody ...
+ * switch -regexp -- word simpleWordPattern simpleWordBody ...
* When the mode is -glob, can also handle a -nocase flag.
*
* First off, we don't care how the command's word was generated; we're
@@ -3875,15 +3875,29 @@ TclCompileSwitchCmd(
numWords = parsePtr->numWords-1;
/*
- * Check for options. There must be at least one, --, because without that
- * there is no way to statically avoid the problems you get from strings-
- * -to-be-matched that start with a - (the interpreted code falls apart if
- * it encounters them, so we punt if we *might* encounter them as that is
- * the easiest way of emulating the behaviour).
+ * Check for options.
*/
noCase = 0;
mode = Switch_Exact;
+ if (numWords == 2) {
+ /*
+ * There's just the switch value and the bodies list. In that case, we
+ * can skip all option parsing and move on to consider switch values
+ * and the body list.
+ */
+
+ goto finishedOptionParse;
+ }
+
+ /*
+ * There must be at least one option, --, because without that there is no
+ * way to statically avoid the problems you get from strings-to-be-matched
+ * that start with a - (the interpreted code falls apart if it encounters
+ * them, so we punt if we *might* encounter them as that is the easiest
+ * way of emulating the behaviour).
+ */
+
for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
register unsigned size = tokenPtr[1].size;
register const char *chrs = tokenPtr[1].start;
@@ -3960,6 +3974,7 @@ TclCompileSwitchCmd(
* compilable too.
*/
+ finishedOptionParse:
valueTokenPtr = tokenPtr;
/* For valueIndex, see previous loop. */
tokenPtr = TokenAfter(tokenPtr);
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 717e718..4ece190 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -12,12 +12,12 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEnv.c,v 1.33.2.2 2007/11/21 06:30:50 dgp Exp $
+ * RCS: @(#) $Id: tclEnv.c,v 1.33.2.3 2007/12/04 16:55:53 dgp Exp $
*/
#include "tclInt.h"
-TCL_DECLARE_MUTEX(envMutex); /* To serialize access to environ. */
+TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
static struct {
int cacheSize; /* Number of env strings in cache. */
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index a5c8778..f062cde 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded tcltest 2.3b1 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.3.0 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 5ec51a3..d792831 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -16,7 +16,7 @@
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
#
-# RCS: @(#) $Id: tcltest.tcl,v 1.100.2.1 2007/09/11 21:33:01 dgp Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.100.2.2 2007/12/04 16:55:53 dgp Exp $
package require Tcl 8.5 ;# -verbose line uses [info frame]
namespace eval tcltest {
@@ -24,7 +24,7 @@ namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
- variable Version 2.3b1
+ variable Version 2.3.0
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
diff --git a/tests/switch.test b/tests/switch.test
index 830f400..5304835 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -11,180 +11,173 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: switch.test,v 1.16 2006/10/09 19:15:45 msofer Exp $
+# RCS: @(#) $Id: switch.test,v 1.16.4.1 2007/12/04 16:55:54 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
test switch-1.1 {simple patterns} {
- switch a a {format 1} b {format 2} c {format 3} default {format 4}
+ switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 1
test switch-1.2 {simple patterns} {
- switch b a {format 1} b {format 2} c {format 3} default {format 4}
+ switch b a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.3 {simple patterns} {
- switch x a {format 1} b {format 2} c {format 3} default {format 4}
+ switch x a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 4
test switch-1.4 {simple patterns} {
- switch x a {format 1} b {format 2} c {format 3}
+ switch x a {subst 1} b {subst 2} c {subst 3}
} {}
test switch-1.5 {simple pattern matches many times} {
- switch b a {format 1} b {format 2} b {format 3} b {format 4}
+ switch b a {subst 1} b {subst 2} b {subst 3} b {subst 4}
} 2
test switch-1.6 {simple patterns} {
- switch default a {format 1} default {format 2} c {format 3} default {format 4}
+ switch default a {subst 1} default {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.7 {simple patterns} {
- switch x a {format 1} default {format 2} c {format 3} default {format 4}
+ switch x a {subst 1} default {subst 2} c {subst 3} default {subst 4}
} 4
test switch-1.8 {simple patterns with -nocase} {
- switch -nocase b a {format 1} b {format 2} c {format 3} default {format 4}
+ switch -nocase b a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.9 {simple patterns with -nocase} {
- switch -nocase B a {format 1} b {format 2} c {format 3} default {format 4}
+ switch -nocase B a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.10 {simple patterns with -nocase} {
- switch -nocase b a {format 1} B {format 2} c {format 3} default {format 4}
+ switch -nocase b a {subst 1} B {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.11 {simple patterns with -nocase} {
- switch -nocase x a {format 1} default {format 2} c {format 3} default {format 4}
+ switch -nocase x a {subst 1} default {subst 2} c {subst 3} default {subst 4}
} 4
test switch-2.1 {single-argument form for pattern/command pairs} {
switch b {
- a {format 1}
- b {format 2}
- default {format 6}
+ a {subst 1}
+ b {subst 2}
+ default {subst 6}
}
} {2}
-test switch-2.2 {single-argument form for pattern/command pairs} {
- list [catch {switch z {a 2 b}} msg] $msg
-} {1 {extra switch pattern with no body}}
+test switch-2.2 {single-argument form for pattern/command pairs} -body {
+ switch z {a 2 b}
+} -returnCodes error -result {extra switch pattern with no body}
test switch-3.1 {-exact vs. -glob vs. -regexp} {
switch -exact aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} exact
test switch-3.2 {-exact vs. -glob vs. -regexp} {
switch -regexp aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} regexp
test switch-3.3 {-exact vs. -glob vs. -regexp} {
switch -glob aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} glob
test switch-3.4 {-exact vs. -glob vs. -regexp} {
- switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
- aaaab {concat exact} default {concat none}
+ switch aaaab {^a*b$} {subst regexp} *b {subst glob} \
+ aaaab {subst exact} default {subst none}
} exact
test switch-3.5 {-exact vs. -glob vs. -regexp} {
switch -- -glob {
- ^g.*b$ {concat regexp}
- -* {concat glob}
- -glob {concat exact}
- default {concat none}
+ ^g.*b$ {subst regexp}
+ -* {subst glob}
+ -glob {subst exact}
+ default {subst none}
}
} exact
-test switch-3.6 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -foo a b c} msg] $msg
-} {1 {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --}}
+test switch-3.6 {-exact vs. -glob vs. -regexp} -body {
+ switch -foo a b c
+} -returnCodes error -result {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --}
test switch-3.7 {-exact vs. -glob vs. -regexp with -nocase} {
switch -exact -nocase aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} exact
test switch-3.8 {-exact vs. -glob vs. -regexp with -nocase} {
switch -regexp -nocase aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} regexp
test switch-3.9 {-exact vs. -glob vs. -regexp with -nocase} {
switch -glob -nocase aaaab {
- ^a*b$ {concat regexp}
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
+ ^a*b$ {subst regexp}
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
}
} glob
test switch-3.10 {-exact vs. -glob vs. -regexp with -nocase} {
- switch -nocase aaaab {^a*b$} {concat regexp} *b {concat glob} \
- aaaab {concat exact} default {concat none}
+ switch -nocase aaaab {^a*b$} {subst regexp} *b {subst glob} \
+ aaaab {subst exact} default {subst none}
} exact
test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} {
switch -nocase -- -glob {
- ^g.*b$ {concat regexp}
- -* {concat glob}
- -glob {concat exact}
- default {concat none}
+ ^g.*b$ {subst regexp}
+ -* {subst glob}
+ -glob {subst exact}
+ default {subst none}
}
} exact
-
test switch-3.12 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -exa Foo Foo {set result OK}} msg] $msg
-} {0 OK}
-
+ switch -exa Foo Foo {set result OK}
+} OK
test switch-3.13 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -gl Foo Fo? {set result OK}} msg] $msg
-} {0 OK}
-
+ switch -gl Foo Fo? {set result OK}
+} OK
test switch-3.14 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -re Foo Fo. {set result OK}} msg] $msg
-} {0 OK}
-
-test switch-3.15 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -exact -exact Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-exact": -exact option already found}}
-
-test switch-3.16 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -exact -glob Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-glob": -exact option already found}}
-
-test switch-3.17 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -glob -regexp Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-regexp": -glob option already found}}
-
-test switch-3.18 {-exact vs. -glob vs. -regexp} {
- list [catch {switch -regexp -glob Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-glob": -regexp option already found}}
+ switch -re Foo Fo. {set result OK}
+} OK
+test switch-3.15 {-exact vs. -glob vs. -regexp} -body {
+ switch -exact -exact Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-exact": -exact option already found}
+test switch-3.16 {-exact vs. -glob vs. -regexp} -body {
+ switch -exact -glob Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-glob": -exact option already found}
+test switch-3.17 {-exact vs. -glob vs. -regexp} -body {
+ switch -glob -regexp Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-regexp": -glob option already found}
+test switch-3.18 {-exact vs. -glob vs. -regexp} -body {
+ switch -regexp -glob Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-glob": -regexp option already found}
test switch-4.1 {error in executed command} {
- list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
+ list [catch {switch a a {error "Just a test"} default {subst 1}} msg] \
$msg $::errorInfo
} {1 {Just a test} {Just a test
while executing
"error "Just a test""
("a" arm line 1)
invoked from within
-"switch a a {error "Just a test"} default {format 1}"}}
-test switch-4.2 {error: not enough args} {
- list [catch {switch} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
-test switch-4.3 {error: pattern with no body} {
- list [catch {switch a b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-4.4 {error: pattern with no body} {
- list [catch {switch a b {format 1} c} msg] $msg
-} {1 {extra switch pattern with no body}}
+"switch a a {error "Just a test"} default {subst 1}"}}
+test switch-4.2 {error: not enough args} -returnCodes error -body {
+ switch
+} -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}
+test switch-4.3 {error: pattern with no body} -body {
+ switch a b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-4.4 {error: pattern with no body} -body {
+ switch a b {subst 1} c
+} -returnCodes error -result {extra switch pattern with no body}
test switch-4.5 {error in default command} {
list [catch {switch foo a {error switch1} b {error switch 3} \
default {error switch2}} msg] $msg $::errorInfo
@@ -195,30 +188,30 @@ test switch-4.5 {error in default command} {
invoked from within
"switch foo a {error switch1} b {error switch 3} default {error switch2}"}}
-test switch-5.1 {errors in -regexp matching} {
- list [catch {switch -regexp aaaab {
- *b {concat glob}
- aaaab {concat exact}
- default {concat none}
- }} msg] $msg
-} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
+test switch-5.1 {errors in -regexp matching} -returnCodes error -body {
+ switch -regexp aaaab {
+ *b {subst glob}
+ aaaab {subst exact}
+ default {subst none}
+ }
+} -result {couldn't compile regular expression pattern: quantifier operand invalid}
test switch-6.1 {backslashes in patterns} {
switch -exact {\a\$\.\[} {
- \a\$\.\[ {concat first}
- \a\\$\.\\[ {concat second}
- \\a\\$\\.\\[ {concat third}
- {\a\\$\.\\[} {concat fourth}
- {\\a\\$\\.\\[} {concat fifth}
- default {concat none}
+ \a\$\.\[ {subst first}
+ \a\\$\.\\[ {subst second}
+ \\a\\$\\.\\[ {subst third}
+ {\a\\$\.\\[} {subst fourth}
+ {\\a\\$\\.\\[} {subst fifth}
+ default {subst none}
}
} third
test switch-6.2 {backslashes in patterns} {
switch -exact {\a\$\.\[} {
- \a\$\.\[ {concat first}
- {\a\$\.\[} {concat second}
- {{\a\$\.\[}} {concat third}
- default {concat none}
+ \a\$\.\[ {subst first}
+ {\a\$\.\[} {subst second}
+ {{\a\$\.\[}} {subst third}
+ default {subst none}
}
} second
@@ -226,37 +219,31 @@ test switch-7.1 {"-" bodies} {
switch a {
a -
b -
- c {concat 1}
- default {concat 2}
+ c {subst 1}
+ default {subst 2}
}
} 1
-test switch-7.2 {"-" bodies} {
- list [catch {
- switch a {
- a -
- b -
- c -
- }
- } msg] $msg
-} {1 {no body specified for pattern "c"}}
-test switch-7.3 {"-" bodies} {
- list [catch {
- switch a {
- a -
- b -foo
- c -
- }
- } msg] $msg
-} {1 {no body specified for pattern "c"}}
-test switch-7.4 {"-" bodies} {
- list [catch {
- switch a {
- a -
- b -foo
- c {}
- }
- } msg] $msg
-} {1 {invalid command name "-foo"}}
+test switch-7.2 {"-" bodies} -body {
+ switch a {
+ a -
+ b -
+ c -
+ }
+} -returnCodes error -result {no body specified for pattern "c"}
+test switch-7.3 {"-" bodies} -body {
+ switch a {
+ a -
+ b -foo
+ c -
+ }
+} -returnCodes error -result {no body specified for pattern "c"}
+test switch-7.4 {"-" bodies} -body {
+ switch a {
+ a -
+ b -foo
+ c {}
+ }
+} -returnCodes error -result {invalid command name "-foo"}
test switch-8.1 {empty body} {
set msg {}
@@ -266,18 +253,15 @@ test switch-8.1 {empty body} {
default {set msg 2}
}
} {}
-
proc test_switch_body {} {
return "INVOKED"
}
-
test switch-8.2 {weird body text, variable} {
set cmd {test_switch_body}
switch Foo {
Foo $cmd
}
} {INVOKED}
-
test switch-8.3 {weird body text, variable} {
set cmd {test_switch_body}
switch Foo {
@@ -285,54 +269,63 @@ test switch-8.3 {weird body text, variable} {
}
} {INVOKED}
-test switch-9.1 {empty pattern/body list} {
- list [catch {switch x} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
-test switch-9.2 {empty pattern/body list} {
- list [catch {switch -- x} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
-test switch-9.3 {empty pattern/body list} {
- list [catch {switch x {}} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
-test switch-9.4 {empty pattern/body list} {
- list [catch {switch -- x {}} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
-test switch-9.5 {unpaired pattern} {
- list [catch {switch x a {} b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.6 {unpaired pattern} {
- list [catch {switch x {a {} b}} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.7 {unpaired pattern} {
- list [catch {switch x a {} # comment b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.8 {unpaired pattern} {
- list [catch {switch x {a {} # comment b}} msg] $msg
-} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
-test switch-9.9 {unpaired pattern} {
- list [catch {switch x a {} x {} # comment b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.10 {unpaired pattern} {
- list [catch {switch x {a {} x {} # comment b}} msg] $msg
-} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
+test switch-9.1 {empty pattern/body list} -returnCodes error -body {
+ switch x
+} -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}
+test switch-9.2 {unpaired pattern} -returnCodes error -body {
+ switch -- x
+} -result {extra switch pattern with no body}
+test switch-9.3 {empty pattern/body list} -body {
+ switch x {}
+} -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}
+test switch-9.4 {empty pattern/body list} -body {
+ switch -- x {}
+} -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}
+test switch-9.5 {unpaired pattern} -body {
+ switch x a {} b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.6 {unpaired pattern} -body {
+ switch x {a {} b}
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.7 {unpaired pattern} -body {
+ switch x a {} # comment b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.8 {unpaired pattern} -returnCodes error -body {
+ switch x {a {} # comment b}
+} -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}
+test switch-9.9 {unpaired pattern} -body {
+ switch x a {} x {} # comment b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.10 {unpaired pattern} -returnCodes error -body {
+ switch x {a {} x {} # comment b}
+} -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}
test switch-10.1 {compiled -exact switch} {
- if 1 {switch -exact -- a {a {format 1} b {format 2}}}
+ if 1 {switch -exact -- a {a {subst 1} b {subst 2}}}
+} 1
+test switch-10.1a {compiled -exact switch} {
+ if 1 {switch -exact a {a {subst 1} b {subst 2}}}
} 1
test switch-10.2 {compiled -exact switch} {
- if 1 {switch -exact -- b {a {format 1} b {format 2}}}
+ if 1 {switch -exact -- b {a {subst 1} b {subst 2}}}
+} 2
+test switch-10.2a {compiled -exact switch} {
+ if 1 {switch -exact b {a {subst 1} b {subst 2}}}
} 2
test switch-10.3 {compiled -exact switch} {
- if 1 {switch -exact -- c {a {format 1} b {format 2}}}
+ if 1 {switch -exact -- c {a {subst 1} b {subst 2}}}
+} {}
+test switch-10.3a {compiled -exact switch} {
+ if 1 {switch -exact c {a {subst 1} b {subst 2}}}
} {}
test switch-10.4 {compiled -exact switch} {
if 1 {
set x 0
- switch -exact -- c {a {format 1} b {format 2}}
+ switch -exact -- c {a {subst 1} b {subst 2}}
}
} {}
test switch-10.5 {compiled -exact switch} {
- if 1 {switch -exact -- a {a - aa {format 1} b {format 2}}}
+ if 1 {switch -exact -- a {a - aa {subst 1} b {subst 2}}}
} 1
test switch-10.6 {compiled -exact switch} {
if 1 {switch -exact -- b {a {
@@ -344,7 +337,7 @@ test switch-10.6 {compiled -exact switch} {
set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
- } b {format 2}}}
+ } b {subst 2}}}
} 2
# Command variants are:
@@ -354,7 +347,7 @@ test switch-10.6 {compiled -exact switch} {
proc cswtest-glob s {
set x 0; set y 0
foreach c [split $s {}] {
- switch -glob -- $c {
+ switch -glob $c {
a {incr x}
b {incr y}
}
@@ -368,7 +361,7 @@ proc cswtest-glob s {
proc iswtest-glob s {
set x 0; set y 0; set switch switch
foreach c [split $s {}] {
- $switch -glob -- $c {
+ $switch -glob $c {
a {incr x}
b {incr y}
}
@@ -382,7 +375,7 @@ proc iswtest-glob s {
proc cswtest-exact s {
set x 0; set y 0
foreach c [split $s {}] {
- switch -exact -- $c {
+ switch -exact $c {
a {incr x}
b {incr y}
}
@@ -396,7 +389,7 @@ proc cswtest-exact s {
proc iswtest-exact s {
set x 0; set y 0; set switch switch
foreach c [split $s {}] {
- $switch -exact -- $c {
+ $switch -exact $c {
a {incr x}
b {incr y}
}
@@ -410,7 +403,7 @@ proc iswtest-exact s {
proc cswtest2-glob s {
set x 0; set y 0; set z 0
foreach c [split $s {}] {
- switch -glob -- $c {
+ switch -glob $c {
a {incr x}
b {incr y}
default {incr z}
@@ -425,7 +418,7 @@ proc cswtest2-glob s {
proc iswtest2-glob s {
set x 0; set y 0; set z 0; set switch switch
foreach c [split $s {}] {
- $switch -glob -- $c {
+ $switch -glob $c {
a {incr x}
b {incr y}
default {incr z}
@@ -440,7 +433,7 @@ proc iswtest2-glob s {
proc cswtest2-exact s {
set x 0; set y 0; set z 0
foreach c [split $s {}] {
- switch -exact -- $c {
+ switch -exact $c {
a {incr x}
b {incr y}
default {incr z}
@@ -455,7 +448,7 @@ proc cswtest2-exact s {
proc iswtest2-exact s {
set x 0; set y 0; set z 0; set switch switch
foreach c [split $s {}] {
- $switch -exact -- $c {
+ $switch -exact $c {
a {incr x}
b {incr y}
default {incr z}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 4d92dab..818c651 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -4,7 +4,7 @@
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.207.2.12 2007/10/19 14:30:02 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.207.2.13 2007/12/04 16:55:54 dgp Exp $
VERSION = @TCL_VERSION@
MAJOR_VERSION = @TCL_MAJOR_VERSION@
@@ -791,8 +791,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
done;
@echo "Installing package msgcat 1.4.2 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;
- @echo "Installing package tcltest 2.3b1 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3b1.tm;
+ @echo "Installing package tcltest 2.3.0 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.0.tm;
@echo "Installing package platform 1.0.3 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.3.tm;
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 5d81a57..2745e9b 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixChan.c,v 1.77.2.5 2007/11/16 07:20:58 dgp Exp $
+ * RCS: @(#) $Id: tclUnixChan.c,v 1.77.2.6 2007/12/04 16:55:54 dgp Exp $
*/
#include "tclInt.h" /* Internal definitions for Tcl. */
@@ -2686,8 +2686,12 @@ CreateSocketAddress(
switch (result) {
case EAI_NONAME:
case EAI_SERVICE:
+#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME
case EAI_ADDRFAMILY:
+#endif
+#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME
case EAI_NODATA:
+#endif
*errorMsgPtr = gai_strerror(result);
errno = EHOSTUNREACH;
return 0;
diff --git a/win/.cvsignore b/win/.cvsignore
index bcf3b41..72c5007 100644
--- a/win/.cvsignore
+++ b/win/.cvsignore
@@ -1,17 +1,18 @@
-Debug
-Release
-*.opt
-*.ncb
-*.plg
-*.00?
-*.o
-*.obj
-*.i
-*.asm
-Makefile
-tcl.hpj
-tclConfig.sh
-nmakehlp.exe
-.#*
-tcl.sln
-tcl.suo
+Debug
+Release
+*.opt
+*.ncb
+*.plg
+*.00?
+*.o
+*.obj
+*.i
+*.asm
+*.dll
+*.exe
+Makefile
+tcl.hpj
+tclConfig.sh
+.#*
+tcl.sln
+tcl.suo
diff --git a/win/Makefile.in b/win/Makefile.in
index 830e076..f9bbd92 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -4,7 +4,7 @@
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.115.2.4 2007/10/15 18:38:09 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.115.2.5 2007/12/04 16:55:55 dgp Exp $
VERSION = @TCL_VERSION@
@@ -644,8 +644,8 @@ install-libraries: libraries install-tzdata install-msgs
done;
@echo "Installing package msgcat 1.4.2 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;
- @echo "Installing package tcltest 2.3b1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3b1.tm;
+ @echo "Installing package tcltest 2.3.0 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.0.tm;
@echo "Installing package platform 1.0.3 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.3.tm;
@echo "Installing package platform::shell 1.1.3 as a Tcl Module";
diff --git a/win/configure b/win/configure
index 5827150..ef3e311 100755
--- a/win/configure
+++ b/win/configure
@@ -3377,8 +3377,8 @@ echo "$as_me: WARNING: 64bit mode not supported with GCC on Windows" >&2;}
fi
SHLIB_LD=""
SHLIB_LD_LIBS=""
- LIBS=""
- LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -lole32 -loleaut32 -luuid"
+ LIBS="-lws2_32"
+ LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid"
STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
@@ -3554,6 +3554,7 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
fi
fi
+ LIBS="user32.lib advapi32.lib ws2_32.lib"
if test "$do64bit" != "no" ; then
# The space-based-path will work for the Makefile, but will
# not work if AC_TRY_COMPILE is called. TEA has the
@@ -3568,7 +3569,7 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
LINKBIN="\"${PATH64}/link.exe\""
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
- LIBS="user32.lib advapi32.lib bufferoverflowU.lib"
+ LIBS="$LIBS bufferoverflowU.lib"
else
RC="rc"
# -Od - no optimization
@@ -3578,7 +3579,6 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
lflags="-nologo"
LINKBIN="link"
- LIBS="user32.lib advapi32.lib"
fi
if test "$doWince" != "no" ; then
@@ -3684,7 +3684,7 @@ _ACEOF
LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
LIBS_GUI="commctrl.lib commdlg.lib"
else
- LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
fi
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
diff --git a/win/makefile.vc b/win/makefile.vc
index 20b2ceb..760e3f7 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -12,7 +12,7 @@
# Copyright (c) 2001-2004 David Gravereaux.
#
#------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.160.2.7 2007/10/17 14:38:40 dgp Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.160.2.8 2007/12/04 16:55:55 dgp Exp $
#------------------------------------------------------------------------------
# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
@@ -476,7 +476,7 @@ dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-baselibs = kernel32.lib user32.lib
+baselibs = kernel32.lib user32.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
diff --git a/win/tcl.m4 b/win/tcl.m4
index 33076d6..63b9053 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -446,8 +446,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
SHLIB_LD=""
SHLIB_LD_LIBS=""
- LIBS=""
- LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -lole32 -loleaut32 -luuid"
+ LIBS="-lws2_32"
+ LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid"
STLIB_LD='${AR} cr'
RC_OUT=-o
RC_TYPE=
@@ -613,6 +613,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
fi
fi
+ LIBS="user32.lib advapi32.lib ws2_32.lib"
if test "$do64bit" != "no" ; then
# The space-based-path will work for the Makefile, but will
# not work if AC_TRY_COMPILE is called. TEA has the
@@ -627,7 +628,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
LINKBIN="\"${PATH64}/link.exe\""
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
- LIBS="user32.lib advapi32.lib bufferoverflowU.lib"
+ LIBS="$LIBS bufferoverflowU.lib"
else
RC="rc"
# -Od - no optimization
@@ -637,7 +638,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
lflags="-nologo"
LINKBIN="link"
- LIBS="user32.lib advapi32.lib"
fi
if test "$doWince" != "no" ; then
@@ -730,7 +730,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
LIBS_GUI="commctrl.lib commdlg.lib"
else
- LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
fi
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 4da0958..3b07522 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinSock.c,v 1.57.2.1 2007/11/28 20:30:34 dgp Exp $
+ * RCS: @(#) $Id: tclWinSock.c,v 1.57.2.2 2007/12/04 16:55:55 dgp Exp $
*/
#include "tclWinInt.h"
@@ -32,7 +32,8 @@
/*
* The following variable is used to tell whether this module has been
- * initialized.
+ * initialized. If 1, initialization of sockets was successful, if -1 then
+ * socket initialization failed (WSAStartup failed).
*/
static int initialized = 0;
@@ -48,94 +49,6 @@ static ProcessGlobalValue hostName = {
};
/*
- * Mingw, Cygwin and OpenWatcom may not have LPFN_* typedefs.
- */
-
-#ifdef HAVE_NO_LPFN_DECLS
-typedef SOCKET (PASCAL FAR *LPFN_ACCEPT)(SOCKET s, struct sockaddr FAR *addr,
- int FAR *addrlen);
-typedef int (PASCAL FAR *LPFN_BIND)(SOCKET s, const struct sockaddr FAR *addr,
- int namelen);
-typedef int (PASCAL FAR *LPFN_CLOSESOCKET)(SOCKET s);
-typedef int (PASCAL FAR *LPFN_CONNECT)(SOCKET s,
- const struct sockaddr FAR *name, int namelen);
-typedef struct hostent FAR *(PASCAL FAR *LPFN_GETHOSTBYADDR)
- (const char FAR *addr, int addrlen, int addrtype);
-typedef struct hostent FAR *(PASCAL FAR *LPFN_GETHOSTBYNAME)
- (const char FAR *name);
-typedef int (PASCAL FAR *LPFN_GETHOSTNAME)(char FAR *name, int namelen);
-typedef int (PASCAL FAR *LPFN_GETPEERNAME)(SOCKET sock,
- struct sockaddr FAR *name, int FAR *namelen);
-typedef struct servent FAR *(PASCAL FAR *LPFN_GETSERVBYNAME)
- (const char FAR *name, const char FAR *proto);
-typedef int (PASCAL FAR *LPFN_GETSOCKNAME)(SOCKET sock,
- struct sockaddr FAR *name, int FAR *namelen);
-typedef int (PASCAL FAR *LPFN_GETSOCKOPT)(SOCKET s, int level, int optname,
- char FAR *optval, int FAR *optlen);
-typedef u_short (PASCAL FAR *LPFN_HTONS)(u_short hostshort);
-typedef unsigned long (PASCAL FAR *LPFN_INET_ADDR)(const char FAR *cp);
-typedef char FAR *(PASCAL FAR *LPFN_INET_NTOA)(struct in_addr in);
-typedef int (PASCAL FAR *LPFN_IOCTLSOCKET)(SOCKET s, long cmd,
- u_long FAR *argp);
-typedef int (PASCAL FAR *LPFN_LISTEN)(SOCKET s, int backlog);
-typedef u_short (PASCAL FAR *LPFN_NTOHS)(u_short netshort);
-typedef int (PASCAL FAR *LPFN_RECV)(SOCKET s, char FAR *buf, int len,
- int flags);
-typedef int (PASCAL FAR *LPFN_SELECT)(int nfds, fd_set FAR *readfds,
- fd_set FAR *writefds, fd_set FAR *exceptfds,
- const struct timeval FAR *timeout);
-typedef int (PASCAL FAR *LPFN_SEND)(SOCKET s,
- const char FAR *buf, int len, int flags);
-typedef int (PASCAL FAR *LPFN_SETSOCKOPT)(SOCKET s, int level, int optname,
- const char FAR *optval, int optlen);
-typedef SOCKET (PASCAL FAR *LPFN_SOCKET)(int af, int type, int protocol);
-typedef int (PASCAL FAR *LPFN_WSAASYNCSELECT)(SOCKET s, HWND hWnd, u_int wMsg,
- long lEvent);
-typedef int (PASCAL FAR *LPFN_WSACLEANUP)(void);
-typedef int (PASCAL FAR *LPFN_WSAGETLASTERROR)(void);
-typedef int (PASCAL FAR *LPFN_WSASTARTUP)(WORD wVersionRequired,
- LPWSADATA lpWSAData);
-#endif
-
-/*
- * The following structure contains pointers to all of the WinSock API entry
- * points used by Tcl. It is initialized by InitSockets. Since we dynamically
- * load the Winsock DLL on demand, we must use this function table to refer to
- * functions in the winsock API.
- */
-
-static struct {
- HMODULE hModule; /* Handle to WinSock library. */
- /* Winsock 1.1 functions */
- LPFN_ACCEPT accept;
- LPFN_BIND bind;
- LPFN_CLOSESOCKET closesocket;
- LPFN_CONNECT connect;
- LPFN_GETHOSTBYADDR gethostbyaddr;
- LPFN_GETHOSTBYNAME gethostbyname;
- LPFN_GETHOSTNAME gethostname;
- LPFN_GETPEERNAME getpeername;
- LPFN_GETSERVBYNAME getservbyname;
- LPFN_GETSOCKNAME getsockname;
- LPFN_GETSOCKOPT getsockopt;
- LPFN_HTONS htons;
- LPFN_INET_ADDR inet_addr;
- LPFN_INET_NTOA inet_ntoa;
- LPFN_IOCTLSOCKET ioctlsocket;
- LPFN_LISTEN listen;
- LPFN_NTOHS ntohs;
- LPFN_RECV recv;
- LPFN_SELECT select;
- LPFN_SEND send;
- LPFN_SETSOCKOPT setsockopt;
- LPFN_SOCKET socket;
- LPFN_WSAASYNCSELECT WSAAsyncSelect;
- LPFN_WSACLEANUP WSACleanup;
- LPFN_WSAGETLASTERROR WSAGetLastError;
- LPFN_WSASTARTUP WSAStartup;
-} winSock;
-
-/*
* The following defines declare the messages used on socket windows.
*/
@@ -288,9 +201,8 @@ static Tcl_ChannelType tcpChannelType = {
*
* InitSockets --
*
- * Initialize the socket module. Attempts to load the wsock32.dll library
- * and set up the winSock function table. If successful, registers the
- * event window for the socket notifier code.
+ * Initialize the socket module. If winsock startup is successful,
+ * registers the event window for the socket notifier code.
*
* Assumes socketMutex is held.
*
@@ -298,8 +210,8 @@ static Tcl_ChannelType tcpChannelType = {
* None.
*
* Side effects:
- * Dynamically loads wsock32.dll, and registers a new window class and
- * creates a window for use in asynchronous socket notification.
+ * Initializes winsock, registers a new window class and creates a
+ * window for use in asynchronous socket notification.
*
*----------------------------------------------------------------------
*/
@@ -317,103 +229,6 @@ InitSockets(void)
initialized = 1;
Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
- winSock.hModule = LoadLibraryA("wsock32.dll");
-
- if (winSock.hModule == NULL) {
- return;
- }
-
- /*
- * Initialize the function table.
- */
-
- winSock.accept = (LPFN_ACCEPT)
- GetProcAddress(winSock.hModule, "accept");
- winSock.bind = (LPFN_BIND)
- GetProcAddress(winSock.hModule, "bind");
- winSock.closesocket = (LPFN_CLOSESOCKET)
- GetProcAddress(winSock.hModule, "closesocket");
- winSock.connect = (LPFN_CONNECT)
- GetProcAddress(winSock.hModule, "connect");
- winSock.gethostbyaddr = (LPFN_GETHOSTBYADDR)
- GetProcAddress(winSock.hModule, "gethostbyaddr");
- winSock.gethostbyname = (LPFN_GETHOSTBYNAME)
- GetProcAddress(winSock.hModule, "gethostbyname");
- winSock.gethostname = (LPFN_GETHOSTNAME)
- GetProcAddress(winSock.hModule, "gethostname");
- winSock.getpeername = (LPFN_GETPEERNAME)
- GetProcAddress(winSock.hModule, "getpeername");
- winSock.getservbyname = (LPFN_GETSERVBYNAME)
- GetProcAddress(winSock.hModule, "getservbyname");
- winSock.getsockname = (LPFN_GETSOCKNAME)
- GetProcAddress(winSock.hModule, "getsockname");
- winSock.getsockopt = (LPFN_GETSOCKOPT)
- GetProcAddress(winSock.hModule, "getsockopt");
- winSock.htons = (LPFN_HTONS)
- GetProcAddress(winSock.hModule, "htons");
- winSock.inet_addr = (LPFN_INET_ADDR)
- GetProcAddress(winSock.hModule, "inet_addr");
- winSock.inet_ntoa = (LPFN_INET_NTOA)
- GetProcAddress(winSock.hModule, "inet_ntoa");
- winSock.ioctlsocket = (LPFN_IOCTLSOCKET)
- GetProcAddress(winSock.hModule, "ioctlsocket");
- winSock.listen = (LPFN_LISTEN)
- GetProcAddress(winSock.hModule, "listen");
- winSock.ntohs = (LPFN_NTOHS)
- GetProcAddress(winSock.hModule, "ntohs");
- winSock.recv = (LPFN_RECV)
- GetProcAddress(winSock.hModule, "recv");
- winSock.select = (LPFN_SELECT)
- GetProcAddress(winSock.hModule, "select");
- winSock.send = (LPFN_SEND)
- GetProcAddress(winSock.hModule, "send");
- winSock.setsockopt = (LPFN_SETSOCKOPT)
- GetProcAddress(winSock.hModule, "setsockopt");
- winSock.socket = (LPFN_SOCKET)
- GetProcAddress(winSock.hModule, "socket");
- winSock.WSAAsyncSelect = (LPFN_WSAASYNCSELECT)
- GetProcAddress(winSock.hModule, "WSAAsyncSelect");
- winSock.WSACleanup = (LPFN_WSACLEANUP)
- GetProcAddress(winSock.hModule, "WSACleanup");
- winSock.WSAGetLastError = (LPFN_WSAGETLASTERROR)
- GetProcAddress(winSock.hModule, "WSAGetLastError");
- winSock.WSAStartup = (LPFN_WSASTARTUP)
- GetProcAddress(winSock.hModule, "WSAStartup");
-
- /*
- * Now check that all fields are properly initialized. If not, return
- * zero to indicate that we failed to initialize properly.
- */
-
- if ((winSock.accept == NULL) ||
- (winSock.bind == NULL) ||
- (winSock.closesocket == NULL) ||
- (winSock.connect == NULL) ||
- (winSock.gethostbyname == NULL) ||
- (winSock.gethostbyaddr == NULL) ||
- (winSock.gethostname == NULL) ||
- (winSock.getpeername == NULL) ||
- (winSock.getservbyname == NULL) ||
- (winSock.getsockname == NULL) ||
- (winSock.getsockopt == NULL) ||
- (winSock.htons == NULL) ||
- (winSock.inet_addr == NULL) ||
- (winSock.inet_ntoa == NULL) ||
- (winSock.ioctlsocket == NULL) ||
- (winSock.listen == NULL) ||
- (winSock.ntohs == NULL) ||
- (winSock.recv == NULL) ||
- (winSock.select == NULL) ||
- (winSock.send == NULL) ||
- (winSock.setsockopt == NULL) ||
- (winSock.socket == NULL) ||
- (winSock.WSAAsyncSelect == NULL) ||
- (winSock.WSACleanup == NULL) ||
- (winSock.WSAGetLastError == NULL) ||
- (winSock.WSAStartup == NULL)) {
- goto unloadLibrary;
- }
-
/*
* Create the async notification window with a new class. We must
* create a new class to avoid a Windows 95 bug that causes us to get
@@ -434,7 +249,7 @@ InitSockets(void)
if (!RegisterClassA(&windowClass)) {
TclWinConvertError(GetLastError());
- goto unloadLibrary;
+ goto initFailure;
}
/*
@@ -447,10 +262,10 @@ InitSockets(void)
#define WSA_VERSION_MINOR 1
#define WSA_VERSION_REQD MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)
- err = winSock.WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
+ err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
if (err != 0) {
TclWinConvertWSAError(err);
- goto unloadLibrary;
+ goto initFailure;
}
/*
@@ -462,8 +277,8 @@ InitSockets(void)
if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
TclWinConvertWSAError(WSAVERNOTSUPPORTED);
- winSock.WSACleanup();
- goto unloadLibrary;
+ WSACleanup();
+ goto initFailure;
}
#undef WSA_VERSION_REQD
@@ -482,16 +297,16 @@ InitSockets(void)
tsdPtr->threadId = Tcl_GetCurrentThread();
tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
if (tsdPtr->readyEvent == NULL) {
- goto unloadLibrary;
+ goto initFailure;
}
tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
if (tsdPtr->socketListLock == NULL) {
- goto unloadLibrary;
+ goto initFailure;
}
tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr,
0, &id);
if (tsdPtr->socketThread == NULL) {
- goto unloadLibrary;
+ goto initFailure;
}
SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);
@@ -504,17 +319,16 @@ InitSockets(void)
WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
if (tsdPtr->hwnd == NULL) {
- goto unloadLibrary; /* Trouble creating the window */
+ goto initFailure; /* Trouble creating the window */
}
Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
}
return;
- unloadLibrary:
+ initFailure:
TclpFinalizeSockets();
- FreeLibrary(winSock.hModule);
- winSock.hModule = NULL;
+ initialized = -1;
return;
}
@@ -523,7 +337,7 @@ InitSockets(void)
*
* SocketsEnabled --
*
- * Check that the WinSock DLL is loaded and ready.
+ * Check that the WinSock was successfully initialized.
*
* Results:
* 1 if it is.
@@ -540,7 +354,7 @@ SocketsEnabled(void)
{
int enabled;
Tcl_MutexLock(&socketMutex);
- enabled = (winSock.hModule != NULL);
+ enabled = (initialized == 1);
Tcl_MutexUnlock(&socketMutex);
return enabled;
}
@@ -569,19 +383,14 @@ SocketExitHandler(
ClientData clientData) /* Not used. */
{
Tcl_MutexLock(&socketMutex);
- if (winSock.hModule) {
-
- /*
- * Make sure the socket event handling window is cleaned-up for, at
- * most, this thread.
- */
+ /*
+ * Make sure the socket event handling window is cleaned-up for, at
+ * most, this thread.
+ */
- TclpFinalizeSockets();
- UnregisterClass("TclSocket", TclWinGetTclInstance());
- winSock.WSACleanup();
- FreeLibrary(winSock.hModule);
- winSock.hModule = NULL;
- }
+ TclpFinalizeSockets();
+ UnregisterClass("TclSocket", TclWinGetTclInstance());
+ WSACleanup();
initialized = 0;
Tcl_MutexUnlock(&socketMutex);
}
@@ -886,7 +695,7 @@ SocketEventProc(
timeout.tv_usec = 0;
timeout.tv_sec = 0;
- if (winSock.select(0, &readFds, NULL, NULL, &timeout) != 0) {
+ if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
mask |= TCL_READABLE;
} else {
infoPtr->readyEvents &= ~(FD_READ);
@@ -985,8 +794,8 @@ TcpCloseProc(
* background.
*/
- if (winSock.closesocket(infoPtr->socket) == SOCKET_ERROR) {
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
+ if (closesocket(infoPtr->socket) == SOCKET_ERROR) {
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
}
}
@@ -1105,7 +914,7 @@ CreateSocket(
goto error;
}
- sock = winSock.socket(AF_INET, SOCK_STREAM, 0);
+ sock = socket(AF_INET, SOCK_STREAM, 0);
if (sock == INVALID_SOCKET) {
goto error;
}
@@ -1134,8 +943,8 @@ CreateSocket(
* look for bugs.
*/
- if (winSock.bind(sock, (SOCKADDR *) &sockaddr,
- sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
+ if (bind(sock, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN))
+ == SOCKET_ERROR) {
goto error;
}
@@ -1145,7 +954,7 @@ CreateSocket(
* there may be differences between TCP/IP stacks).
*/
- if (winSock.listen(sock, SOMAXCONN) == SOCKET_ERROR) {
+ if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
goto error;
}
@@ -1168,8 +977,8 @@ CreateSocket(
*/
if (myaddr != NULL || myport != 0) {
- if (winSock.bind(sock, (SOCKADDR *) &mysockaddr,
- sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
+ if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN))
+ == SOCKET_ERROR) {
goto error;
}
}
@@ -1180,8 +989,7 @@ CreateSocket(
*/
if (async) {
- if (winSock.ioctlsocket(sock, (long) FIONBIO,
- &flag) == SOCKET_ERROR) {
+ if (ioctlsocket(sock, (long) FIONBIO, &flag) == SOCKET_ERROR) {
goto error;
}
}
@@ -1190,9 +998,9 @@ CreateSocket(
* Attempt to connect to the remote socket.
*/
- if (winSock.connect(sock, (SOCKADDR *) &sockaddr,
+ if (connect(sock, (SOCKADDR *) &sockaddr,
sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
if (Tcl_GetErrno() != EWOULDBLOCK) {
goto error;
}
@@ -1227,20 +1035,19 @@ CreateSocket(
* automatically places the socket into non-blocking mode.
*/
- winSock.ioctlsocket(sock, (long) FIONBIO, &flag);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) infoPtr);
+ ioctlsocket(sock, (long) FIONBIO, &flag);
+ SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);
return infoPtr;
error:
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't open socket: ",
Tcl_PosixError(interp), NULL);
}
if (sock != INVALID_SOCKET) {
- winSock.closesocket(sock);
+ closesocket(sock);
}
return NULL;
}
@@ -1284,13 +1091,13 @@ CreateSocketAddress(
ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN));
sockaddrPtr->sin_family = AF_INET;
- sockaddrPtr->sin_port = winSock.htons((u_short) (port & 0xFFFF));
+ sockaddrPtr->sin_port = htons((u_short) (port & 0xFFFF));
if (host == NULL) {
addr.s_addr = INADDR_ANY;
} else {
- addr.s_addr = winSock.inet_addr(host);
+ addr.s_addr = inet_addr(host);
if (addr.s_addr == INADDR_NONE) {
- hostent = winSock.gethostbyname(host);
+ hostent = gethostbyname(host);
if (hostent != NULL) {
memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
} else {
@@ -1594,7 +1401,7 @@ TcpAccept(
len = sizeof(SOCKADDR_IN);
- newSocket = winSock.accept(infoPtr->socket, (SOCKADDR *)&addr,
+ newSocket = accept(infoPtr->socket, (SOCKADDR *)&addr,
&len);
/*
@@ -1662,8 +1469,7 @@ TcpAccept(
if (infoPtr->acceptProc != NULL) {
(infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
- winSock.inet_ntoa(addr.sin_addr),
- winSock.ntohs(addr.sin_port));
+ inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
}
}
@@ -1739,7 +1545,7 @@ TcpInputProc(
while (1) {
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) UNSELECT, (LPARAM) infoPtr);
- bytesRead = winSock.recv(infoPtr->socket, buf, toRead, 0);
+ bytesRead = recv(infoPtr->socket, buf, toRead, 0);
infoPtr->readyEvents &= ~(FD_READ);
/*
@@ -1768,7 +1574,7 @@ TcpInputProc(
* Check for error condition or underflow in non-blocking case.
*/
- error = winSock.WSAGetLastError();
+ error = WSAGetLastError();
if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
TclWinConvertWSAError(error);
*errorCodePtr = Tcl_GetErrno();
@@ -1849,7 +1655,7 @@ TcpOutputProc(
SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
(WPARAM) UNSELECT, (LPARAM) infoPtr);
- bytesWritten = winSock.send(infoPtr->socket, buf, toWrite, 0);
+ bytesWritten = send(infoPtr->socket, buf, toWrite, 0);
if (bytesWritten != SOCKET_ERROR) {
/*
* Since Windows won't generate a new write event until we hit an
@@ -1871,7 +1677,7 @@ TcpOutputProc(
* send fails with WSAEWOULDBLOCK.
*/
- error = winSock.WSAGetLastError();
+ error = WSAGetLastError();
if (error == WSAEWOULDBLOCK) {
infoPtr->readyEvents &= ~(FD_WRITE);
if (infoPtr->flags & SOCKET_ASYNC) {
@@ -1956,10 +1762,10 @@ TcpSetOptionProc(
if (boolVar) {
val = TRUE;
}
- rtn = winSock.setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
+ rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
- TclWinConvertWSAError(winSock.WSAGetLastError());
+ TclWinConvertWSAError(WSAGetLastError());
if (interp) {
Tcl_AppendResult(interp, "couldn't set socket option: ",
Tcl_PosixError(interp), NULL);
@@ -1977,10 +1783,10 @@ TcpSetOptionProc(
if (!boolVar) {
val = TRUE;
}
- rtn = winSock.setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
+ rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
(const char *) &val, sizeof(BOOL));
if (rtn != 0) {
- TclWinConvertWSAError(winSock.WSAGetLastError());
+ TclWinConvertWSAError(WSAGetLastError());
if (interp) {
Tcl_AppendResult(interp, "couldn't set socket option: ",
Tcl_PosixError(interp), NULL);
@@ -2064,7 +1870,7 @@ TcpGetOptionProc(
ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR,
(char *)&err, &optlen);
if (ret == SOCKET_ERROR) {
- err = winSock.WSAGetLastError();
+ err = WSAGetLastError();
}
if (err) {
TclWinConvertWSAError(err);
@@ -2075,28 +1881,25 @@ TcpGetOptionProc(
if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
(strncmp(optionName, "-peername", len) == 0))) {
- if (winSock.getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) {
+ if (getpeername(sock, (LPSOCKADDR) &peername, &size) == 0) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-peername");
Tcl_DStringStartSublist(dsPtr);
}
- Tcl_DStringAppendElement(dsPtr,
- winSock.inet_ntoa(peername.sin_addr));
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
if (peername.sin_addr.s_addr == 0) {
hostEntPtr = NULL;
} else {
- hostEntPtr = winSock.gethostbyaddr(
- (char *) &(peername.sin_addr),
+ hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
sizeof(peername.sin_addr), AF_INET);
}
if (hostEntPtr != NULL) {
Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
} else {
- Tcl_DStringAppendElement(dsPtr,
- winSock.inet_ntoa(peername.sin_addr));
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
}
- TclFormatInt(buf, winSock.ntohs(peername.sin_port));
+ TclFormatInt(buf, ntohs(peername.sin_port));
Tcl_DStringAppendElement(dsPtr, buf);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
@@ -2112,7 +1915,7 @@ TcpGetOptionProc(
*/
if (len) {
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
if (interp) {
Tcl_AppendResult(interp, "can't get peername: ",
Tcl_PosixError(interp), NULL);
@@ -2124,27 +1927,24 @@ TcpGetOptionProc(
if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
(strncmp(optionName, "-sockname", len) == 0))) {
- if (winSock.getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) {
+ if (getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-sockname");
Tcl_DStringStartSublist(dsPtr);
}
- Tcl_DStringAppendElement(dsPtr,
- winSock.inet_ntoa(sockname.sin_addr));
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
if (sockname.sin_addr.s_addr == 0) {
hostEntPtr = NULL;
} else {
- hostEntPtr = winSock.gethostbyaddr(
- (char *) &(sockname.sin_addr),
+ hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
sizeof(peername.sin_addr), AF_INET);
}
if (hostEntPtr != NULL) {
Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
} else {
- Tcl_DStringAppendElement(dsPtr,
- winSock.inet_ntoa(sockname.sin_addr));
+ Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
}
- TclFormatInt(buf, winSock.ntohs(sockname.sin_port));
+ TclFormatInt(buf, ntohs(sockname.sin_port));
Tcl_DStringAppendElement(dsPtr, buf);
if (len == 0) {
Tcl_DStringEndSublist(dsPtr);
@@ -2153,7 +1953,7 @@ TcpGetOptionProc(
}
} else {
if (interp) {
- TclWinConvertWSAError((DWORD) winSock.WSAGetLastError());
+ TclWinConvertWSAError((DWORD) WSAGetLastError());
Tcl_AppendResult(interp, "can't get sockname: ",
Tcl_PosixError(interp), NULL);
}
@@ -2170,8 +1970,7 @@ TcpGetOptionProc(
Tcl_DStringAppendElement(dsPtr, "-keepalive");
}
optlen = sizeof(BOOL);
- winSock.getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt,
- &optlen);
+ getsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&opt, &optlen);
if (opt) {
Tcl_DStringAppendElement(dsPtr, "1");
} else {
@@ -2190,7 +1989,7 @@ TcpGetOptionProc(
Tcl_DStringAppendElement(dsPtr, "-nagle");
}
optlen = sizeof(BOOL);
- winSock.getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
+ getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
&optlen);
if (opt) {
Tcl_DStringAppendElement(dsPtr, "0");
@@ -2493,14 +2292,14 @@ SocketProc(
case SOCKET_SELECT:
infoPtr = (SocketInfo *) lParam;
if (wParam == SELECT) {
- winSock.WSAAsyncSelect(infoPtr->socket, hwnd,
+ WSAAsyncSelect(infoPtr->socket, hwnd,
SOCKET_MESSAGE, infoPtr->selectEvents);
} else {
/*
* Clear the selection mask
*/
- winSock.WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
+ WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
}
break;
@@ -2577,15 +2376,15 @@ InitializeHostName(
*/
Tcl_DString inDs;
-
+
Tcl_DStringInit(&inDs);
Tcl_DStringSetLength(&inDs, 255);
- if (winSock.gethostname(Tcl_DStringValue(&inDs),
- Tcl_DStringLength(&inDs)) == 0) {
+ if (gethostname(Tcl_DStringValue(&inDs),
+ Tcl_DStringLength(&inDs)) == 0) {
Tcl_DStringSetLength(&ds, 0);
} else {
- Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs),
- Tcl_DStringLength(&inDs), &ds);
+ Tcl_ExternalToUtfDString(NULL,
+ Tcl_DStringValue(&inDs), -1, &ds);
}
Tcl_DStringFree(&inDs);
}
@@ -2635,7 +2434,7 @@ TclWinGetSockOpt(
return SOCKET_ERROR;
}
- return winSock.getsockopt((SOCKET)s, level, optname, optval, optlen);
+ return getsockopt((SOCKET)s, level, optname, optval, optlen);
}
int
@@ -2656,7 +2455,7 @@ TclWinSetSockOpt(
return SOCKET_ERROR;
}
- return winSock.setsockopt((SOCKET)s, level, optname, optval, optlen);
+ return setsockopt((SOCKET)s, level, optname, optval, optlen);
}
u_short
@@ -2673,7 +2472,7 @@ TclWinNToHS(
return (u_short) -1;
}
- return winSock.ntohs(netshort);
+ return ntohs(netshort);
}
struct servent *
@@ -2691,7 +2490,7 @@ TclWinGetServByName(
return NULL;
}
- return winSock.getservbyname(name, proto);
+ return getservbyname(name, proto);
}
/*
generated by cgit v0.12 at 2024-12-03 19:05:21 (GMT)