Tcl Source Code

Check-in [2c4f496e6a]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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 | SQL 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
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/socket.test.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
444
445
446
447
448
449
450

451
452
453
454
455
456
457
....
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
....
1639
1640
1641
1642
1643
1644
1645

1646

1647

1648

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






|







 







>







 







<
<

<

<


|







 







>

>

>

>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
....
1616
1617
1618
1619
1620
1621
1622


1623

1624

1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
....
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
#
# 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
}

Changes to win/tclWinSock.c.

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






|







 







|







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