Tcl Source Code

Check-in [2c4f496e6a]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix socket code (typo) and test case after looking at it again.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 2c4f496e6af8553b3245a911d6c42550c0b0fa23
User & Date: redman 1999-03-25 01:25:14.000
Context
1999-03-25
01:34
Minor adjustment. check-in: 655b052ea2 user: rjohnson tags: core-8-1-branch-old
01:25
Fix socket code (typo) and test case after looking at it again. check-in: 2c4f496e6a user: redman tags: core-8-1-branch-old
00:34
fixed compiler errors/warnings on VC++ 5.0/6.0 and HP-UX native compiler without -Aa or -Ae check-in: e1542205dd user: redman tags: core-8-1-branch-old
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/socket.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Commands tested in this file: socket.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# Commands tested in this file: socket.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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
444
445
446
447
448
449
450

451
452
453
454
455
456
457
    }
    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} {







>







444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
    }
    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} {
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645

1646

1647

1648

1649
1650
1651
1652
1653
1654
1655
                 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
}







<
<

<

<


|















>

>

>

>







1616
1617
1618
1619
1620
1621
1622


1623

1624

1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
                 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
}
Changes to win/tclWinSock.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tclWinSock.c --
 *
 *	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.










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/* 
 * tclWinSock.c --
 *
 *	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.
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
	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.







|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
	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.