Check-in [ed9d07e135]
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: ed9d07e13597b7d016512f9363b249da6069d5ad
User & Date: awb on 2000-06-03 03:35:36
Other Links: manifest | tags
Context
2000-06-03
05:01
More test fixes. Tests marked "empty" will hang, presumably because of the synchronous nature of those tests. check-in: 2af1d4883b user: awb tags: trunk
03:35
*** empty log message *** check-in: ed9d07e135 user: awb tags: trunk
03:17
*** empty log message *** check-in: a05622355a user: awb tags: trunk
Changes

Modified tests/tlsIo.test from [d49a17444f] to [09e01ca39a].

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
670
671
672
673
674
675
676

677

678
679
680
681
682
683
684
685


686
687
688
689
690
691
692
693
694
695
696
697
698
699
700

701

702
703
704
705
706
707
708
...
722
723
724
725
726
727
728
729


730
731


732
733


734
735
736
737
738
739
740
...
744
745
746
747
748
749
750
751
752
753
754
755
756
757


758
759
760
761
762
763
764
...
784
785
786
787
788
789
790


791
792
793
794
795
796
797
798
...
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
...
937
938
939
940
941
942
943

944
945
946
947
948
949
950
951
952

953
954
955
956
957
958
959

960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
...
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
#
# 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.10 2000/06/03 03:17:58 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
................................................................................


test socket-3.1 {socket conflict} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls

	set f [tls::socket -server accept 2828]

	puts ready
	gets stdin
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    gets $f
    set x [list [catch {tls::socket -server accept 2828} msg] \


		$msg]
    puts $f bye
    close $f
    set x
} {1 {couldn't open socket: address already in use}}

test socket-3.2 {server with several clients} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	set t1 [after 30000 "set x timed_out"]
	set t2 [after 31000 "set x timed_out"]
	set t3 [after 32000 "set x timed_out"]
	set counter 0

	set s [tls::socket -server accept 2828]

	proc accept {s a p} {
	    fileevent $s readable [list echo $s]
	    fconfigure $s -buffering line
	}
	proc echo {s} {
	     global x
             set l [gets $s]
................................................................................
	after cancel $t3
	close $s
	puts $x
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    set x [gets $f]
    set s1 [tls::socket 127.0.0.1 2828]


    fconfigure $s1 -buffering line
    set s2 [tls::socket 127.0.0.1 2828]


    fconfigure $s2 -buffering line
    set s3 [tls::socket 127.0.0.1 2828]


    fconfigure $s3 -buffering line
    for {set i 0} {$i < 100} {incr i} {
	puts $s1 hello,s1
	gets $s1
	puts $s2 hello,s2
	gets $s2
	puts $s3 hello,s3
................................................................................
    close $s2
    close $s3
    lappend x [gets $f]
    close $f
    set x
} {ready done}

test socket-4.1 {server with several clients} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
	set s [tls::socket 127.0.0.1 2828]


	fconfigure $s -buffering line
	for {set i 0} {$i < 100} {incr i} {
	    puts $s hello
	    gets $s
	}
	close $s
	puts bye
................................................................................
        } else {
            puts $s $l
        }
    }
    set t1 [after 30000 "set x timed_out"]
    set t2 [after 31000 "set x timed_out"]
    set t3 [after 32000 "set x timed_out"]


    set s [tls::socket -server accept 2828]
    puts $p1 open
    puts $p2 open
    puts $p3 open
    vwait x
    vwait x
    vwait x
    after cancel $t1
................................................................................
    vwait x
    after cancel $timer
    close $s
    rename bgerror {}
    set x
} {{divide by zero}}

test socket-7.1 {testing socket specific options} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
    }
    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2820"
    puts $f {
................................................................................
    lappend l [llength $p]
    lappend l [lindex $p 0]
    lappend l [expr [lindex $p 2] == 2821]
} {3 127.0.0.1 0}

test socket-7.3 {testing socket specific options} {socket} {
    set s [tls::socket \

    	-server accept 2822]
    set l [fconfigure $s]
    close $s
    update
    llength $l
} 12

test socket-7.4 {testing socket specific options} {socket pcCrash} {
    set s [tls::socket \

    	-server accept 2823]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set s1 [tls::socket \

    	[info hostname] 2823]
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    close $s1
    set l ""
    lappend l [lindex $x 2] [llength $x]
} {2823 3}

test socket-7.5 {testing socket specific options} {socket unixOrPc pcCrash} {
    set s [tls::socket \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    	-server accept 2829]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
................................................................................
    after cancel $timer
    close $s
    close $s1
    set l ""
    lappend l [lindex $x 0] [lindex $x 2] [llength $x]
} {127.0.0.1 2829 3}

test socket-8.1 {testing -async flag on sockets} {empty socket pcCrash} {
    # NOTE: This test may fail on some Solaris 2.4 systems. If it does,
    # check that you have these patches installed (using showrev -p):
    #
    # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
    # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
    # 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,
    # 102066-04, 102070-01, 102105-01, 102153-03, 102216-01, 102232-01,






|







 







>
|
>







|
>
>






|








>
|
>







 







|
>
>

|
>
>

|
>
>







 







|





|
>
>







 







>
>
|







 







|







 







>







|

>







>










|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
...
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
...
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
...
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
...
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
...
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
....
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
#
# 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.11 2000/06/03 03:35:36 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
................................................................................


test socket-3.1 {socket conflict} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2828 \]"
    puts $f {
	puts ready
	gets stdin
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    gets $f
    set x [list [catch {tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
    	-server accept 2828} msg] \
		$msg]
    puts $f bye
    close $f
    set x
} {1 {couldn't open socket: address already in use}}

test socket-3.2 {server with several clients} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	set t1 [after 30000 "set x timed_out"]
	set t2 [after 31000 "set x timed_out"]
	set t3 [after 32000 "set x timed_out"]
	set counter 0
    }
    puts $f "set s \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2828 \]"
    puts $f {
	proc accept {s a p} {
	    fileevent $s readable [list echo $s]
	    fconfigure $s -buffering line
	}
	proc echo {s} {
	     global x
             set l [gets $s]
................................................................................
	after cancel $t3
	close $s
	puts $x
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    set x [gets $f]
    set s1 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 2828]
    fconfigure $s1 -buffering line
    set s2 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 2828]
    fconfigure $s2 -buffering line
    set s3 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 2828]
    fconfigure $s3 -buffering line
    for {set i 0} {$i < 100} {incr i} {
	puts $s1 hello,s1
	gets $s1
	puts $s2 hello,s2
	gets $s2
	puts $s3 hello,s3
................................................................................
    close $s2
    close $s3
    lappend x [gets $f]
    close $f
    set x
} {ready done}

test socket-4.1 {server with several clients} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
    }
    puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 2828 \]"
    puts $f {
	fconfigure $s -buffering line
	for {set i 0} {$i < 100} {incr i} {
	    puts $s hello
	    gets $s
	}
	close $s
	puts bye
................................................................................
        } else {
            puts $s $l
        }
    }
    set t1 [after 30000 "set x timed_out"]
    set t2 [after 31000 "set x timed_out"]
    set t3 [after 32000 "set x timed_out"]
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    	-server accept 2828]
    puts $p1 open
    puts $p2 open
    puts $p3 open
    vwait x
    vwait x
    vwait x
    after cancel $t1
................................................................................
    vwait x
    after cancel $timer
    close $s
    rename bgerror {}
    set x
} {{divide by zero}}

test socket-7.1 {testing socket specific options} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
    }
    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2820"
    puts $f {
................................................................................
    lappend l [llength $p]
    lappend l [lindex $p 0]
    lappend l [expr [lindex $p 2] == 2821]
} {3 127.0.0.1 0}

test socket-7.3 {testing socket specific options} {socket} {
    set s [tls::socket \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    	-server accept 2822]
    set l [fconfigure $s]
    close $s
    update
    llength $l
} 12

test socket-7.4 {testing socket specific options} {socket} {
    set s [tls::socket \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    	-server accept 2823]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set s1 [tls::socket \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
    	[info hostname] 2823]
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    close $s1
    set l ""
    lappend l [lindex $x 2] [llength $x]
} {2823 3}

test socket-7.5 {testing socket specific options} {socket unixOrPc} {
    set s [tls::socket \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    	-server accept 2829]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
................................................................................
    after cancel $timer
    close $s
    close $s1
    set l ""
    lappend l [lindex $x 0] [lindex $x 2] [llength $x]
} {127.0.0.1 2829 3}

test socket-8.1 {testing -async flag on sockets} {empty socket} {
    # NOTE: This test may fail on some Solaris 2.4 systems. If it does,
    # check that you have these patches installed (using showrev -p):
    #
    # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
    # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
    # 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,
    # 102066-04, 102070-01, 102105-01, 102153-03, 102216-01, 102232-01,