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-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tlsIO.test,v 1.13 2000/06/07 02:31:15 aborr 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-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tlsIO.test,v 1.14 2000/06/08 00:06:40 aborr 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
|
︙ | | | ︙ | |
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
|
close $s1
close $s2
close $s3
}
set l
} {4003 {} 1 4004 {} 1 4005 {} 1}
test tlsIO-11.9 {accept callback error} {socket doTestsWithRemoteServer} {
set s [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-server accept 8836]
proc accept {s a p} {expr 10 / 0}
proc bgerror args {
global x
set x $args
|
|
|
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
|
close $s1
close $s2
close $s3
}
set l
} {4003 {} 1 4004 {} 1 4005 {} 1}
test tlsIO-11.9 {accept callback error} {knownBug socket doTestsWithRemoteServer} {
set s [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-server accept 8836]
proc accept {s a p} {expr 10 / 0}
proc bgerror args {
global x
set x $args
|
︙ | | | ︙ | |
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
|
set timer [after 10000 "set done timed_out"]
vwait done
after cancel $timer
sendCommand {close $socket10_13_test_server}
list $spurious $len
} {0 2690}
test tlsIO-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
set counter 0
set done 0
proc count_up {s} {
global counter done after_id
set l [gets $s]
if {[eof $s]} {
incr counter
|
|
|
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
|
set timer [after 10000 "set done timed_out"]
vwait done
after cancel $timer
sendCommand {close $socket10_13_test_server}
list $spurious $len
} {0 2690}
test tlsIO-11.12 {testing EOF stickyness} {knownBug socket doTestsWithRemoteServer} {
set counter 0
set done 0
proc count_up {s} {
global counter done after_id
set l [gets $s]
if {[eof $s]} {
incr counter
|
︙ | | | ︙ | |
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
|
removeFile script1
removeFile script2
set x
} {server socket was not inherited}
test tlsIO-12.2 {testing inheritance of client sockets} \
{socket doTestsWithRemoteServer} {
removeFile script1
removeFile script2
# Script1 is just a 10 second delay. If the server socket
# is inherited, it will be held open for 10 seconds
set f [open script1 w]
|
|
|
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
|
removeFile script1
removeFile script2
set x
} {server socket was not inherited}
test tlsIO-12.2 {testing inheritance of client sockets} \
{unexplainedFailure socket doTestsWithRemoteServer} {
removeFile script1
removeFile script2
# Script1 is just a 10 second delay. If the server socket
# is inherited, it will be held open for 10 seconds
set f [open script1 w]
|
︙ | | | ︙ | |