Tcl Source Code

2012-03-07  Andreas Kupries  <[email protected]>

	* library/http/http.tcl: [Bug 3498327]: Generate upper-case
	* library/http/pkgIndex.tcl: hexadecimal output for compliance
	* tests/http.test: with RFC 3986. Bumped version to 2.8.4.
	* unix/Makefile.in:
	* win/Makefile.in:

2012-03-06  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: Compatibility with older Visual Studio versions.

2012-03-04  Jan Nijtmans  <[email protected]>

	* generic/tclLoad.c: Patch from the cygwin folks
	* unix/tcl.m4:
	* unix/configure: (re-generated)

2012-03-02  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (Tcl_SetByteArrayObj): [Bug 3496014]: Only zero
	out the memory block if it is not being immediately overwritten. (Our
	caller might still overwrite, but we should at least avoid
	known-useless work.)

2012-02-29  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c:	[Bug 3466099]: BOM in Unicode
	* generic/tclEncoding.c:
	* tests/source.test

2012-02-23  Donal K. Fellows  <[email protected]>

	* tests/reg.test (14.21-23): Add tests relating to bug 1115587. Actual
	bug is characterised by test marked with 'knownBug'.

2012-02-17  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c: [Bug 2233954]: AIX: compile error
	* unix/tclUnixPort.h:

2012-02-16  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (INST_LIST_RANGE_IMM): Enhance implementation
	so that shortening a (not multiply-referenced) list by lopping the end
	off with [lrange] or [lreplace] is efficient.

dictionary.  Also, the entries for the keys \fB\-code\fR
and \fB\-level\fR will be adjusted if necessary to agree
with the value of \fIcode\fR.  The \fB(Tcl_Obj *)\fR returned
by \fBTcl_GetReturnOptions\fR points to an unshared
\fBTcl_Obj\fR with reference count of zero.  The dictionary
may be written to, either adding, removing, or overwriting
any entries in it, without the need to check for a shared object.
As with any \fBTcl_Obj\fR with reference count of zero, it is up to
the caller to arrange for its disposal with \fBTcl_DecrRefCount\fR or
to a reference to it via \fBTcl_IncrRefCount\fR (or one of the many
functions that call that, notably including \fBTcl_SetObjResult\fR and
\fBTcl_SetVar2Ex\fR).
.PP
A typical usage for \fBTcl_GetReturnOptions\fR is to
retrieve the stack trace when script evaluation returns
\fBTCL_ERROR\fR, like so:
.PP
.CS
int code = Tcl_Eval(interp, script);
if (code == TCL_ERROR) {
    Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code);  
    Tcl_Obj *key = Tcl_NewStringObj("-errorinfo", -1);
    Tcl_Obj *stackTrace;
    Tcl_IncrRefCount(key);
    Tcl_DictObjGet(NULL, options, key, &stackTrace);
    Tcl_DecrRefCount(key);
    /* Do something with stackTrace */
    Tcl_DecrRefCount(options);
}
.CE
.PP
\fBTcl_SetReturnOptions\fR sets the return options
of \fIinterp\fR to be \fIoptions\fR.  If \fIoptions\fR
contains any invalid value for any key, TCL_ERROR will
be returned, and the interp result will be set to an

	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
    Tcl_InvalidateStringRep(objPtr);

    length = (length < 0) ? 0 : length;
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));

    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;
    if (length) {
	if (bytes) {
	    memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
	} else {
	    memset(byteArrayPtr->bytes, 0, (size_t) length);
	}
    }

    objPtr->typePtr = &tclByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}

/*

void
RecordByteCodeStats(
    ByteCode *codePtr)		/* Points to ByteCode structure with info
				 * to add to accumulated statistics. */
{
    Interp *iPtr = (Interp *) *codePtr->interpHandle;
    register ByteCodeStats *statsPtr;

    if (iPtr == NULL) {
	/* Avoid segfaulting in case we're called in a deleted interp */
	return;
    }
    statsPtr = &(iPtr->stats);

    statsPtr->numCompilations++;
    statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes;
    statsPtr->totalByteCodeBytes += (double) codePtr->structureSize;
    statsPtr->currentSrcBytes += (double) codePtr->numSrcBytes;
    statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;

 *
 *------------------------------------------------------------------------
 */

int
Tcl_SetSystemEncoding(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
    const char *name)		/* The name of the desired encoding, or NULL/""
				 * to reset to default encoding. */
{
    Tcl_Encoding encoding;
    Encoding *encodingPtr;

    if (!name || !*name) {
	Tcl_MutexLock(&encodingMutex);
	encoding = defaultEncoding;
	encodingPtr = (Encoding *) encoding;
	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
    } else {
	encoding = Tcl_GetEncoding(interp, name);

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#if defined(HAVE_SYS_STAT_H) && !defined _WIN32
#   include <sys/stat.h>
#endif
#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

	    Tcl_Close(interp,chan);
	    return result;
	}
    }

    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);
    /* Try to read first character of stream, so we can
     * check for utf-8 BOM to be handled especially.
     */
    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	goto end;
    }
    string = Tcl_GetString(objPtr);
    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them [Bug 3466099].
     */
    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	goto end;
    }

    if (Tcl_Close(interp, chan) != TCL_OK) {

    const char *encodingName)	/* If non-NULL, then use this encoding for the
				 * file. NULL means use the system encoding. */
{
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile, *objPtr;
    Interp *iPtr;
    Tcl_Channel chan;
    const char *string;

    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
	return TCL_ERROR;
    }

    if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
	Tcl_SetErrno(errno);

	    Tcl_Close(interp,chan);
	    return TCL_ERROR;
	}
    }

    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);
    /* Try to read first character of stream, so we can
     * check for utf-8 BOM to be handled especially.
     */
    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
    string = Tcl_GetString(objPtr);
    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them [Bug 3466099].
     */
    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
			Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

    if (Tcl_Close(interp, chan) != TCL_OK) {
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

		splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
		Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
		pkgGuess = Tcl_GetString(pkgGuessPtr);
		if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
			&& (pkgGuess[2] == 'b')) {
		    pkgGuess += 3;
		}
#ifdef __CYGWIN__
		if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
			&& (pkgGuess[2] == 'g')) {
		    pkgGuess += 3;
		}
#endif /* __CYGWIN__ */
		for (p = pkgGuess; *p != 0; p += offset) {
		    offset = Tcl_UtfToUniChar(p, &ch);
		    if ((ch > 0x100)
			    || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
				    || (UCHAR(ch) == '_'))) {
			break;
		    }

 * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
 
#include "tclInt.h"
#include "tclParse.h"

/*
 * The following table provides parsing information about each possible 8-bit
 * character. The table is designed to be referenced with either signed or
 * unsigned characters, so it has 384 entries. The first 128 entries
 * correspond to negative character values, the next 256 correspond to
 * positive character values. The last 128 entries are identical to the first

 *			open bracket.
 * TYPE_QUOTE -		Character is a double quote.
 * TYPE_CLOSE_PAREN -	Character is a right parenthesis.
 * TYPE_CLOSE_BRACK -	Character is a right square bracket.
 * TYPE_BRACE -		Character is a curly brace (either left or right).
 */












const char charTypeTable[] = {
    /*
     * Negative character values, from -128 to -1:
     */

    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,

/*
 * Minimal set of shared macro definitions and declarations so that multiple
 * source files can make use of the parsing table in tclParse.c
 */

#define TYPE_NORMAL		0
#define TYPE_SPACE		0x1
#define TYPE_COMMAND_END	0x2
#define TYPE_SUBS		0x4
#define TYPE_QUOTE		0x8
#define TYPE_CLOSE_PAREN	0x10
#define TYPE_CLOSE_BRACK	0x20
#define TYPE_BRACE		0x40

#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]

MODULE_SCOPE const char charTypeTable[];

 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclParse.h"
#include <math.h>

/*
 * The absolute pathname of the executable in which this Tcl library is
 * running.
 */

	forbidNone = 1;
#if COMPAT
	preferBrace = 1;
#endif
    }

    while (length) {
      if (CHAR_TYPE(*p) != TYPE_NORMAL) {
	switch (*p) {
	case '{':	/* TYPE_BRACE */
#if COMPAT
	    braceCount++;
#endif
	    extra++;				/* Escape '{' => '\{' */
	    nestingLevel++;
	    break;
	case '}':	/* TYPE_BRACE */
#if COMPAT
	    braceCount++;
#endif
	    extra++;				/* Escape '}' => '\}' */
	    nestingLevel--;
	    if (nestingLevel < 0) {
		/* Unbalanced braces!  Cannot format with brace quoting. */
		requireEscape = 1;
	    }
	    break;
	case ']':	/* TYPE_CLOSE_BRACK */
	case '"':	/* TYPE_SPACE */
#if COMPAT
	    forbidNone = 1;
	    extra++;		/* Escapes all just prepend a backslash */
	    preferEscape = 1;
	    break;
#else
	    /* FLOW THROUGH */
#endif
	case '[':	/* TYPE_SUBS */
	case '$':	/* TYPE_SUBS */
	case ';':	/* TYPE_COMMAND_END */
	case ' ':	/* TYPE_SPACE */
	case '\f':	/* TYPE_SPACE */
	case '\n':	/* TYPE_COMMAND_END */
	case '\r':	/* TYPE_SPACE */
	case '\t':	/* TYPE_SPACE */
	case '\v':	/* TYPE_SPACE */
	    forbidNone = 1;
	    extra++;		/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
#endif
	    break;
	case '\\':	/* TYPE_SUBS */
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
		/* Final backslash. Cannot format with brace quoting. */
		requireEscape = 1;		
		break;
	    }
	    if (p[1] == '\n') {

		p++;
	    }
	    forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
#endif
	    break;
	case '\0':	/* TYPE_SUBS */
	    if (length == -1) {
		goto endOfString;
	    }
	    /* TODO: Panic on improper encoding? */
	    break;
	}
      }
	length -= (length > 0);
	p++;
    }

    endOfString:
    if (nestingLevel != 0) {
	/* Unbalanced braces!  Cannot format with brace quoting. */

# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.4

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {

	# encode all except: "... percent-encoded octets in the ranges of
	# ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
	# (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
	# producers ..."
	for {set i 0} {$i <= 256} {incr i} {
	    set c [format %c $i]
	    if {![string match {[-._~a-zA-Z0-9]} $c]} {
		set map($c) %[format %.2X $i]
	    }
	}
	# These are handled specially
	set map(\n) %0D%0A
	variable formMap [array get map]

	# Create a map for HTTP/1.1 open sockets
	variable socketmap
	if {[info exists socketmap]} {
	    # Close but don't remove open sockets on re-init
	    foreach {url sock} [array get socketmap] {

if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded http 2.8.4 [list tclPkgSetup $dir http 2.8.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

test http-5.1 {http::formatQuery} {
    http::formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value%20two}
# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
test http-5.3 {http::formatQuery} {
    http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0D%0Aline2%0D%0Aline3}
test http-5.4 {http::formatQuery} {
    http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2}
test http-5.5 {http::formatQuery} {
    set enc [http::config -urlencoding]
    http::config -urlencoding iso8859-1
    set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
    http::config -urlencoding $enc
    set res
} {name1=~bwelch&name2=%A1%A2%A2}

test http-6.1 {http::ProxyRequired} -body {
    http::config -proxyhost [info hostname] -proxyport $port
    set token [http::geturl $url]
    http::wait $token
    upvar #0 $token data
    set data(body)
} -cleanup {
    http::config -proxyhost {} -proxyport {}
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http:$url</h2>
</body></html>"

test http-7.1 {http::mapReply} {
    http::mapReply "abc\$\[\]\"\\()\}\{"
} {abc%24%5B%5D%22%5C%28%29%7D%7B}
test http-7.2 {http::mapReply} {
    # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
    # so make sure this gets converted to utf-8 then urlencoded.
    http::mapReply "\u2208"
} {%E2%88%88}
test http-7.3 {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -returnCodes error -body {
    # this would be reverting to http <=2.4 behavior
    http::config -urlencoding ""
    http::mapReply "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result "can't read \"formMap(\u2208)\": no such element in array"
test http-7.4 {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -body {
    # this would be reverting to http <=2.4 behavior w/o errors
    # (unknown chars become '?')
    http::config -urlencoding "iso8859-1"
    http::mapReply "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result {%3F}

# cleanup
catch {unset url}
catch {unset badurl}
catch {unset port}
catch {unset data}
if {[info exists httpthread]} {

	foreach f [split $infonameorder ""] {
	    if {[string match *$f* $fl]} {
		lappend ret $infonames($f)
	    }
	}
	return $ret
    }

    # Share the generation of the list of test constraints so it is
    # done the same on all routes.
    proc TestConstraints {flags} {
	set constraints [list testregexp]

	variable regBug
	if {$regBug} {
	    # This will trigger registration as a skipped test
	    lappend constraints knownBug
	}

	# Tcl locale stuff doesn't do the ch/xy test fakery yet
	if {[string match *+* $flags]} {
	    # This will trigger registration as a skipped test
	    lappend constraints localeRegexp
	}

	return $constraints
    }

    # match expected, internal routine that does the work
    # parameters like the "real" routines except they don't have "opts",
    #  which is a possibly-empty list of switches for the regexp match attempt
    # The ! flag is used to indicate expected match failure (for REG_EXPECT,
    #  which wants argument testing even in the event of failure).
    proc MatchExpected {opts testid flags re target args} {


	# if &, test as both BRE and ARE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    MatchExpected $opts "$testid ARE" ${f}  $re $target {*}$args
	    MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [TestConstraints $flags]












	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about        {*}$f $re]
	set ecmd [list testregexp {*}$opts {*}$f $re $target]

	set nsub [expr {[llength $args] - 1}]

	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectError "$testid ARE" ${f}  $re $err
	    expectError "$testid BRE" ${f}b $re $err
	    return
	}

	set constraints [TestConstraints $flags]







	set cmd [list testregexp -about {*}[TestFlags $flags] $re]
	::tcltest::test [TestNum $testid error] [TestDesc $testid error] \
		-constraints $constraints -result [list 1 REG_$err] -body \
		"list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]"
    }

    # match failure expected
    proc expectNomatch {testid flags re target args} {
	variable regBug
	# if &, test as both ARE and BRE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectNomatch "$testid ARE" ${f}  $re $target {*}$args
	    expectNomatch "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [TestConstraints $flags]







	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about {*}$f $re]
	set nsub [expr {[llength $args] - 1}]
	if {$nsub == -1} {
	    # didn't tell us number of subexps

    proc knownBug {args} {
	variable regBug 1
	uplevel \#0 $args
	set regBug 0
    }
}
namespace import RETest::*

######## the tests themselves ########

# support functions and preliminary misc.
# This is sensitive to changes in message wording, but we really have to
# test the code->message expansion at least once.
::tcltest::test reg-0.1 "regexp error reporting" {
    list [catch {regexp (*) ign} msg] $msg

expectNomatch	14.14 QRP	"a(\[bc])\\1{3,4}"	abbb
expectMatch	14.15 RP	{a([bc])\1*}	abbb	abbb	b
expectMatch	14.16 RP	{a([bc])\1*}	ab	ab	b
expectMatch	14.17 RP	{a([bc])(\1*)}	ab	ab	b	""
expectError	14.18 -		{a((b)\1)}	ESUBREG
expectError	14.19 -		{a(b)c\2}	ESUBREG
expectMatch	14.20 bR	{a\(b*\)c\1}	abbcbb	abbcbb	bb
expectMatch	14.21 RP	{^([bc])\1*$}	bbb	bbb	b
expectMatch	14.22 RP	{^([bc])\1*$}	ccc	ccc	c
knownBug expectNomatch 14.23 R	{^([bc])\1*$}	bcb


doing 15 "octal escapes vs back references"
# initial zero is always octal
expectMatch	15.1  MP	"a\\010b"	"a\bb"	"a\bb"
expectMatch	15.2  MP	"a\\0070b"	"a\0070b"	"a\0070b"
expectMatch	15.3  MP	"a\\07b"	"a\007b"	"a\007b"

test reg-33.13 {Bug 1810264 - infinite loop} {
    regexp {($|^)*} {x}
} 1
# Some environments have small default stack sizes. [Bug 1905562]
test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable {
    regexp {(x{200}){200}$y} {x}
} 0

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

    set sourcefile [makeFile {} _non_existent_]
    removeFile _non_existent_
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorCode
} -match listGlob -result [list 1 \
	{couldn't read file "*_non_existent_": no such file or directory} \
	{POSIX ENOENT {no such file or directory}}]
test source-2.7 {utf-8 with BOM} -setup {
    set sourcefile [makeFile {} source.file]
} -body {
    set out [open $sourcefile w]
    fconfigure $out -encoding utf-8
    puts $out "\ufeffset y new-y"
    close $out
    set y old-y
    source -encoding utf-8 $sourcefile
    return $y
} -cleanup {
    removeFile $sourcefile
} -result {new-y}

test source-3.1 {return in middle of source file} -setup {
    set sourcefile [makeFile {
	set x new-x
	return allDone
	set y new-y
    } source.file]

	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
	@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
	    done;
	@echo "Installing package http 2.8.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.4.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm;

REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
		$(GENERIC_DIR)/regcustom.h
TCLREHDRS=$(GENERIC_DIR)/tclRegexp.h
COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
FSHDR=$(GENERIC_DIR)/tclFileSystem.h
IOHDR=$(GENERIC_DIR)/tclIO.h
MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
PARSEHDR=$(GENERIC_DIR)/tclParse.h
NREHDR=$(GENERIC_DIR)/tclInt.h

regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
		$(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c

tclOOMethod.o: $(GENERIC_DIR)/tclOOMethod.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOMethod.c

tclOOStubInit.o: $(GENERIC_DIR)/tclOOStubInit.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOStubInit.c

tclParse.o: $(GENERIC_DIR)/tclParse.c $(PARSEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclParse.c

tclPanic.o: $(GENERIC_DIR)/tclPanic.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPanic.c

tclPathObj.o: $(GENERIC_DIR)/tclPathObj.c $(FSHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPathObj.c

tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStubInit.c

tclTrace.o: $(GENERIC_DIR)/tclTrace.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTrace.c

tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c

tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtf.c

tclVar.o: $(GENERIC_DIR)/tclVar.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c

	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,[email protected]'
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"

	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,$[@].a'
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"

	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.8.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.4.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;

#ifndef _WIN32_WINNT
#   define _WIN32_WINNT 0x0501
#endif

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

/* Compatibility to older visual studio / windows platform SDK */
#if !defined(MAXULONG_PTR)
typedef DWORD DWORD_PTR;
typedef DWORD_PTR * PDWORD_PTR;
#endif

/*
 * Ask for the winsock function typedefs, also.
 */
#define INCL_WINSOCK_API_TYPEDEFS   1
#include <winsock2.h>
#include <ws2tcpip.h>