Tcl Source Code

#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: socket.test,v 1.1.2.9 1999/03/24 23:53:17 redman Exp $

# Running socket tests with a remote server:
# ------------------------------------------
# 
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
................................................................................
    }
    close $f
    set f [open "|[list $tcltest script]" r]
    gets $f
    set s [socket 127.0.0.1 2828]
    fconfigure $s -buffering line -translation lf
    puts $s "hello abcdefghijklmnop"

    set x [gets $s]
    close $s
    set y [gets $f]
    close $f
    list $x $y
} {{hello abcdefghijklmnop} done}
test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
................................................................................
                 set x done
             } else { 
	         incr i
                 puts $s $l
             }
	}
	set i 0
	puts ready
	set timer [after 20000 "set x done"]
	vwait x
	after cancel $timer
	close $f
	puts "done $i"

	# thread cleans itself up.
	testhread exit
    }
    close $f
    
    # create a thread
    set serverthread [testthread create { source script } ]
    update
    
................................................................................
    set s [socket 127.0.0.1 2828]
    fconfigure $s -buffering line
    catch {
	puts $s "hello"
	gets $s result
    }
    close $s



    ThreadReap

    set result

} hello

# cleanup
if {[string match sock* $commandSocket] == 1} {
   puts $commandSocket exit
   flush $commandSocket
}

#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: socket.test,v 1.1.2.10 1999/03/25 01:25:14 redman Exp $

# Running socket tests with a remote server:
# ------------------------------------------
# 
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
................................................................................
    }
    close $f
    set f [open "|[list $tcltest script]" r]
    gets $f
    set s [socket 127.0.0.1 2828]
    fconfigure $s -buffering line -translation lf
    puts $s "hello abcdefghijklmnop"
    after 1000
    set x [gets $s]
    close $s
    set y [gets $f]
    close $f
    list $x $y
} {{hello abcdefghijklmnop} done}
test socket-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
................................................................................
                 set x done
             } else { 
	         incr i
                 puts $s $l
             }
	}
	set i 0


	vwait x

	close $f


	# thread cleans itself up.
	testthread exit
    }
    close $f
    
    # create a thread
    set serverthread [testthread create { source script } ]
    update
    
................................................................................
    set s [socket 127.0.0.1 2828]
    fconfigure $s -buffering line
    catch {
	puts $s "hello"
	gets $s result
    }
    close $s
    update

    after 2000
    ThreadReap
    
    set result

} hello

# cleanup
if {[string match sock* $commandSocket] == 1} {
   puts $commandSocket exit
   flush $commandSocket
}

 *	This file contains Windows-specific socket related code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * 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.1.2.7 1999/03/24 23:53:18 redman Exp $
 */

#include "tclWinInt.h"

/*
 * The following variable is used to tell whether this module has been
 * initialized.
................................................................................
	class.hbrBackground = NULL;
	class.lpszMenuName = NULL;
	class.lpszClassName = "TclSocket";
	class.lpfnWndProc = SocketProc;
	class.hIcon = NULL;
	class.hCursor = NULL;

	if (RegisterClassA(&class)) {
	    TclWinConvertError(GetLastError());
	    (*winSock.WSACleanup)();
	    goto unloadLibrary;
	}
	
	/*
	 * Initialize the winsock library and check the version number.

 *	This file contains Windows-specific socket related code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * 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.1.2.8 1999/03/25 01:25:15 redman Exp $
 */

#include "tclWinInt.h"

/*
 * The following variable is used to tell whether this module has been
 * initialized.
................................................................................
	class.hbrBackground = NULL;
	class.lpszMenuName = NULL;
	class.lpszClassName = "TclSocket";
	class.lpfnWndProc = SocketProc;
	class.hIcon = NULL;
	class.hCursor = NULL;

	if (!RegisterClassA(&class)) {
	    TclWinConvertError(GetLastError());
	    (*winSock.WSACleanup)();
	    goto unloadLibrary;
	}
	
	/*
	 * Initialize the winsock library and check the version number.