Check-in [23b3fec5cd]
Overview
Comment:added more tests from socket test suite
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 23b3fec5cd05f4d1a9d9ebc6f15344ceaf48e754
User & Date: aborr on 2000-06-05 20:32:06
Other Links: manifest | tags
Context
2000-06-05
20:39
added more tests from socket test suite check-in: a8042ff3b9 user: aborr tags: trunk
20:32
added more tests from socket test suite check-in: 23b3fec5cd user: aborr tags: trunk
20:25
fixed path to source dir tls.tcl check-in: 2485fa2e8f user: aborr tags: trunk
Changes
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.1 2000/06/05 20:23:41 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.2 2000/06/05 20:32:06 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
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
        close $msg
    }
    lappend x [gets $f]
    close $f
    set x
} {ready done {}}




#################################
if {[string match sock* $commandSocket] == 1} {
   puts $commandSocket exit
   flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
return
#################################
test tlsIo-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 \]"







<
<
<
<
<
<
<
<
<
<
<
<
<
<







662
663
664
665
666
667
668














669
670
671
672
673
674
675
        close $msg
    }
    lappend x [gets $f]
    close $f
    set x
} {ready done {}}















test tlsIo-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 \]"
872
873
874
875
876
877
878











879
880
881
882
883
884
885
    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 tlsIo-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







>
>
>
>
>
>
>
>
>
>
>







858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
    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}

#################################
if {[string match sock* $commandSocket] == 1} {
   puts $commandSocket exit
   flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
::tcltest::cleanupTests
flush stdout
return
#################################
test tlsIo-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