Check-in [47212e1080]
Bounty program for improvements to Tcl and certain Tcl packages.
Overview
Comment:*** empty log message ***
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 47212e108020feedebd3cd4cc0a93b3e96b3fc6f
User & Date: awb on 2000-06-02 19:17:11
Other Links: manifest | tags
Context
2000-06-02
20:25
X.509 certificates and key files for testing check-in: 53405cf7b6 user: aborr tags: trunk
19:17
*** empty log message *** check-in: 47212e1080 user: awb tags: trunk
18:47
Preliminary version of Tcl's socket.test modified for tls. check-in: e8ea3bd13a user: awb tags: trunk
Changes

Modified tests/tlsIo.test from [61b0b6bf3a] to [1116f46566].

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
463
464
465
466
467
468
469
470
471

472
473
474
475
476
477
478
...
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526






527
528
529
530
531
532
533
534
...
751
752
753
754
755
756
757
758
759
760
761

762
763
764
765
766
767
768
...
802
803
804
805
806
807
808
809
810
811
812

813
814
815
816
817
818
819
....
1598
1599
1600
1601
1602
1603
1604

1605
1606
1607
1608
1609
1610
1611
#
# 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: tlsIo.test,v 1.1 2000/06/02 18:47:38 awb 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
................................................................................
    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} {
    makeFile {

	set f [tls::socket -server accept 2835]
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	proc echo {s} {
	     global i
................................................................................
    set x
} {done 50}

test socket-2.9 {socket conflict} {socket stdio} {
    set s [tls::socket -server accept 2828]
    removeFile script
    set f [open script w]
    puts -nonewline $f {tls::socket -server accept 2828}
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f
    after 100
    set x [list [catch {close $f} msg] $msg]
    close $s
    set x
} {1 {couldn't open socket: address already in use
    while executing






"socket -server accept 2828"
    (file "script" line 1)}}

test socket-2.10 {close on accept, accepted socket lives} {socket pcCrash} {
    set done 0
    set timer [after 20000 "set done timed_out"]
    set ss [tls::socket -server accept 2830]
    proc accept {s a p} {
................................................................................
    if {![catch {tls::socket -server dodo 21} msg]} {
	set x {htons problem, should be disallowed, are you running as SU?}
	close $msg
    }
    set x
} {couldn't open socket: not owner}

test socket-6.1 {accept callback error} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {

	gets stdin
	tls::socket 127.0.0.1 2848
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    proc bgerror args {
	global x
................................................................................
    close $s
    close $f
    set l ""
    lappend l [string compare [lindex $p 0] 127.0.0.1]
    lappend l [string compare [lindex $p 2] 2820]
    lappend l [llength $p]
} {0 0 3}
test socket-7.2 {testing socket specific options} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {

	tls::socket -server accept 2821
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 "set x timed_out"]
................................................................................
test socket-13.1 {Testing use of shared socket between two threads} \
	{socket testthread} {

    removeFile script
    threadReap

    makeFile {

	set f [tls::socket -server accept 2828]
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	proc echo {s} {
	     global i






|







 







|

>







 







|









>
>
>
>
>
>
|







 







|



>







 







|



>







 







>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
...
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
...
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
...
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
....
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
#
# 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: tlsIo.test,v 1.2 2000/06/02 19:17:11 awb 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
................................................................................
    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 pcCrash} {
    makeFile {
    	package require tls
	set f [tls::socket -server accept 2835]
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	proc echo {s} {
	     global i
................................................................................
    set x
} {done 50}

test socket-2.9 {socket conflict} {socket stdio} {
    set s [tls::socket -server accept 2828]
    removeFile script
    set f [open script w]
    puts -nonewline $f {package require tls; tls::socket -server accept 2828}
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f
    after 100
    set x [list [catch {close $f} msg] $msg]
    close $s
    set x
} {1 {couldn't open socket: address already in use
    while executing
"::socket -server {tls::_accept {-server 1} accept} 2828"
    ("eval" body line 1)
    invoked from within
"eval ::socket $sopts"
    (procedure "tls::socket" line 62)
    invoked from within
"tls::socket -server accept 2828"
    (file "script" line 1)}}

test socket-2.10 {close on accept, accepted socket lives} {socket pcCrash} {
    set done 0
    set timer [after 20000 "set done timed_out"]
    set ss [tls::socket -server accept 2830]
    proc accept {s a p} {
................................................................................
    if {![catch {tls::socket -server dodo 21} msg]} {
	set x {htons problem, should be disallowed, are you running as SU?}
	close $msg
    }
    set x
} {couldn't open socket: not owner}

test socket-6.1 {accept callback error} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
	tls::socket 127.0.0.1 2848
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    proc bgerror args {
	global x
................................................................................
    close $s
    close $f
    set l ""
    lappend l [string compare [lindex $p 0] 127.0.0.1]
    lappend l [string compare [lindex $p 2] 2820]
    lappend l [llength $p]
} {0 0 3}
test socket-7.2 {testing socket specific options} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
	tls::socket -server accept 2821
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 "set x timed_out"]
................................................................................
test socket-13.1 {Testing use of shared socket between two threads} \
	{socket testthread} {

    removeFile script
    threadReap

    makeFile {
    	package require tls
	set f [tls::socket -server accept 2828]
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	proc echo {s} {
	     global i