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].

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
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.10 2000/06/03 03:17:58 awb Exp $
# 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
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
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






+
-
+
+







-
+
+
+






-
+








+
-
+
+








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 $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 -server accept 2828} msg] \
    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 pcCrash} {
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
    }
	set s [tls::socket -server accept 2828]
    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]
722
723
724
725
726
727
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
753
754
755
756

757


758
759
760
761
762
763
764
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
753
754
755
756
757
758
759
760
761
762

763
764
765
766
767
768
769

770
771
772
773
774
775
776
777
778






-
+
+
+

-
+
+
+

-
+
+
+

















-
+





+
-
+
+







	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]
    set s1 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 2828]
    fconfigure $s1 -buffering line
    set s2 [tls::socket 127.0.0.1 2828]
    set s2 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 2828]
    fconfigure $s2 -buffering line
    set s3 [tls::socket 127.0.0.1 2828]
    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
	gets $s3
    }
    close $s1
    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} {
test socket-4.1 {server with several clients} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
    }
	set s [tls::socket 127.0.0.1 2828]
    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
784
785
786
787
788
789
790
791



792
793
794
795
796
797
798
798
799
800
801
802
803
804

805
806
807
808
809
810
811
812
813
814






-
+
+
+







        } 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]
    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
871
872
873
874
875
876
877
878

879
880
881
882
883
884
885
887
888
889
890
891
892
893

894
895
896
897
898
899
900
901






-
+







    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} {
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 {
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
978
979
980
981
982
983
984
985
986
987
988
989
990
991

992
993
994
995
996
997
998
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
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009

1010
1011
1012
1013
1014
1015
1016
1017






+







-
+

+







+










-
+




















-
+







    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 pcCrash} {
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 pcCrash} {
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
    }
    set s1 [tls::socket \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
    	127.0.0.1 2829]
    set timer [after 10000 "set x timed_out"]
    vwait x
    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} {
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,