Tcl Source Code

2014-10-03 (bug)[bc1a96] segfault in [array set] of traced array (tab,porter)

2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans)

2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter)

2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter)

2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter)

--- Released 8.6.3, October 29, 2014 --- http://core.tcl.tk/tcl/ for details

    dst = objPtr->bytes + oldLength;
    dstEnd = dst;

    skip = 0;
    eof = NULL;
    inEofChar = statePtr->inEofChar;

    ResetFlag(statePtr, CHANNEL_BLOCKED);
    while (1) {
	if (dst >= dstEnd) {
	    if (FilterInputBytes(chanPtr, &gs) != 0) {
		goto restore;
	    }
	    dstEnd = dst + gs.bytesWrote;
	}

    /*
     * Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR.
     */

    eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';

    ResetFlag(statePtr, CHANNEL_BLOCKED);
    while (1) {
	/*
	 * Subtract the number of bytes that were removed from channel
	 * buffer during last call.
	 */

	if (bufPtr != NULL) {

	/*
	 * All channel buffers were exhausted and the caller still hasn't seen
	 * EOL. Need to read more bytes from the channel device. Side effect
	 * is to allocate another channel buffer.
	 */

    read:
	if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
		== (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
	    gsPtr->charsWrote = 0;
	    gsPtr->rawRead = 0;
	    return -1;
	}
	if (GetInput(chanPtr) != 0) {
	    gsPtr->charsWrote = 0;
	    gsPtr->rawRead = 0;
	    return -1;
	}
	bufPtr = statePtr->inQueueTail;
	gsPtr->bufPtr = bufPtr;

		bufPtr->nextRemoved = bufPtr->nextAdded;
	    } else {
		/*
		 * There are no more cached raw bytes left. See if we can get
		 * some more, but avoid blocking on a non-blocking channel.
		 */







		goto read;
	    }
	} else {
	    if (nextPtr == NULL) {
		nextPtr = AllocChannelBuffer(statePtr->bufSize);
		bufPtr->nextPtr = nextPtr;
		statePtr->inQueueTail = nextPtr;

    close $f
    set f [open $path(test3) r]
    fconfigure $f -translation lf
    for {set y 0} {$y < 300} {incr y} {gets $f}
    close $f
    set y
} 300
test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) .......
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
		if {$n > 3} {set n 3}
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -translation binary -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c
    rename driver {}
} -result {{} {} {} .......}
test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) .......
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
		if {$n > 3} {set n 3}
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c
    rename driver {}
} -result {{} {} {} .......}
test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [string repeat \
                        [string repeat . 64]\n[string repeat . 25] 2]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                if {$n > 65} {set n 65}
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
} -body {
    set c [chan create read [namespace which driver]]
    chan configure $c -blocking 0
    list [gets $c] [gets $c] [gets $c] [gets $c] [gets $c]
} -cleanup {
    close $c
    rename driver {}
} -result [list [string repeat . 64] {} [string repeat . 89] \
	[string repeat . 25] {}]

# Test Tcl_Seek and Tcl_Tell.

test io-34.1 {Tcl_Seek to current position at start of file} {
    set f1 [open $path(longfile) r]
    seek $f1 0 current
    set c [tell $f1]

        set s [socket -async localhost [randport]]
        set x ok
        fileevent $s writable {set x fail}
        catch {read $s}
	close $s
        set x
    } -result ok

# v4 and v6 is required to prevent that the async connect does not terminate
# before the fconfigure command. There is always an additional ip to try.
test socket-14.16 {empty -peername while [socket -async] connecting} \
    -constraints {socket localhost_v4 localhost_v6} \
    -body {
        set client [socket -async localhost [randport]]
        fconfigure $client -peername
    } -cleanup {
        catch {close $client}
    } -result {}

# v4 and v6 is required to prevent that the async connect does not terminate
# before the fconfigure command. There is always an additional ip to try.
test socket-14.17 {empty -sockname while [socket -async] connecting} \
    -constraints {socket localhost_v4 localhost_v6} \
    -body {
        set client [socket -async localhost [randport]]
        fconfigure $client -sockname
    } -cleanup {
        catch {close $client}
    } -result {}

set num 0

set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}}
set resultok {-result "sock*" -match glob}
set resulterr {
    -result {couldn't open socket: connection refused}

    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
        address peername;
        socklen_t size = sizeof(peername);

	if ( (statePtr->flags & TCP_ASYNC_CONNECT) ) {
	    /*
	     * In async connect output an empty string
	     */
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringAppendElement(dsPtr, "");
	    } else {
		return TCL_OK;
	    }
	} else if (getpeername(statePtr->fds.fd, &peername.sa, &size) >= 0) {
	    /*
	     * Peername fetch succeeded - output list
	     */
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);
	    }
            TcpHostPortList(interp, dsPtr, peername, size);
	    if (len) {
                return TCL_OK;

        socklen_t size;
	int found = 0;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-sockname");
	    Tcl_DStringStartSublist(dsPtr);
	}
	if ( (statePtr->flags & TCP_ASYNC_CONNECT) ) {
	    /*
	     * In async connect output an empty string
	     */
	     found = 1;
	} else {
	    for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
		size = sizeof(sockname);
		if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) {
		    found = 1;
		    TcpHostPortList(interp, dsPtr, sockname, size);
		}
	    }
	}
        if (found) {
            if (len) {
                return TCL_OK;
            }
            Tcl_DStringEndSublist(dsPtr);

    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
	address peername;
	socklen_t size = sizeof(peername);

	if ( (statePtr->flags & TCP_ASYNC_PENDING) ) {
	    /*
	     * In async connect output an empty string
	     */
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringAppendElement(dsPtr, "");
	    } else {
		return TCL_OK;
	    }
	} else if ( getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
	    /*
	     * Peername fetch succeeded - output list
	     */
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);
	    }

	    getnameinfo(&(peername.sa), size, host, sizeof(host),
		    NULL, 0, NI_NUMERICHOST);

	socklen_t size;
	int found = 0;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-sockname");
	    Tcl_DStringStartSublist(dsPtr);
	}
	if ( (statePtr->flags & TCP_ASYNC_PENDING ) ) {
	    /*
	     * In async connect output an empty string
	     */
	     found = 1;
	} else {
	    for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
		sock = fds->fd;
		size = sizeof(sockname);
		if (getsockname(sock, &(sockname.sa), &size) >= 0) {
		    int flags = reverseDNS;

		    found = 1;
		    getnameinfo(&sockname.sa, size, host, sizeof(host),
			    NULL, 0, NI_NUMERICHOST);
		    Tcl_DStringAppendElement(dsPtr, host);

		    /*
		     * We don't want to resolve INADDR_ANY and sin6addr_any; they
		     * can sometimes cause problems (and never have a name).
		     */
		    flags |= NI_NUMERICSERV;
		    if (sockname.sa.sa_family == AF_INET) {
			if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
			    flags |= NI_NUMERICHOST;
			}
		    } else if (sockname.sa.sa_family == AF_INET6) {
			if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
				    &in6addr_any)) ||
				(IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
				&& sockname.sa6.sin6_addr.s6_addr[12] == 0
				&& sockname.sa6.sin6_addr.s6_addr[13] == 0
				&& sockname.sa6.sin6_addr.s6_addr[14] == 0
				&& sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
			    flags |= NI_NUMERICHOST;
			}
		    }
		    getnameinfo(&sockname.sa, size, host, sizeof(host),
			    port, sizeof(port), flags);
		    Tcl_DStringAppendElement(dsPtr, host);
		    Tcl_DStringAppendElement(dsPtr, port);
		}
	    }
	}
	if (found) {
	    if (len) {


		return TCL_OK;
	    }
	    Tcl_DStringEndSublist(dsPtr);
	} else {
	    if (interp) {
		TclWinConvertError((DWORD) WSAGetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't get sockname: %s", Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;