Check-in [570604a410]
Overview
Comment:*** empty log message ***
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 570604a4101a9b2d7852c238211564b5fb09f64b
User & Date: awb on 2000-06-02 20:45:38
Other Links: manifest | tags
Context
2000-06-02
21:44
Fix test 2.2. check-in: a1d3dcc242 user: awb tags: trunk
20:45
*** empty log message *** check-in: 570604a410 user: awb tags: trunk
20:25
X.509 certificates and key files for testing check-in: 53405cf7b6 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-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












|







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-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.3 2000/06/02 20:45: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
281
282
283
284
285
286
287

288
289
290
291
292
293
294
} {ready done {}}

if [info exists port] {
    incr port
} else { 
    set port [expr 2048 + [pid]%1024]
}

test socket-2.2 {tcp connection with client port specified} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
	set timer [after 2000 "set x done"]
        set f [tls::socket -server accept 2829]







>







281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
} {ready done {}}

if [info exists port] {
    incr port
} else { 
    set port [expr 2048 + [pid]%1024]
}

test socket-2.2 {tcp connection with client port specified} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
	set timer [after 2000 "set x done"]
        set f [tls::socket -server accept 2829]
316
317
318
319
320
321
322

323
324
325
326
327
328
329
	flush $sock
        lappend x [gets $f]
        close $sock
    }
    close $f
    set x
} [list ready "hello $port"]

test socket-2.3 {tcp connection with client interface specified} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
	set timer [after 2000 "set x done"]
        set f [tls::socket  -server accept 2830]







>







317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
	flush $sock
        lappend x [gets $f]
        close $sock
    }
    close $f
    set x
} [list ready "hello $port"]

test socket-2.3 {tcp connection with client interface specified} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
	set timer [after 2000 "set x done"]
        set f [tls::socket  -server accept 2830]
348
349
350
351
352
353
354

355
356
357
358
359
360
361
	flush $sock
        lappend x [gets $f]
        close $sock
    }
    close $f
    set x
} {ready {hello 127.0.0.1}}

test socket-2.4 {tcp connection with server interface specified} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
	set timer [after 2000 "set x done"]
        set f [tls::socket -server accept -myaddr [info hostname] 2831]







>







350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
	flush $sock
        lappend x [gets $f]
        close $sock
    }
    close $f
    set x
} {ready {hello 127.0.0.1}}

test socket-2.4 {tcp connection with server interface specified} {socket stdio pcCrash} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
	set timer [after 2000 "set x done"]
        set f [tls::socket -server accept -myaddr [info hostname] 2831]
586
587
588
589
590
591
592

593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611

612
613
614
615
616
617
618
} {one {} two}


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

	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 {

	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]







>



















>







589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
} {one {} two}


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]
659
660
661
662
663
664
665
666
667
668
669

670
671
672
673
674
675
676
677
678
    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 {

	gets stdin
	set s [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







|



>

|







664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
    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
721
722
723
724
725
726
727

728
729
730
731
732
733
734
    puts $p2 bye
    puts $p3 bye
    close $p1
    close $p2
    close $p3
    set l
} {{p1 bye done} {p2 bye done} {p3 bye done}}

test socket-4.2 {byte order problems, socket numbers, htons} {socket} {
    set x ok
    if {[catch {tls::socket -server dodo 0x3000} msg]} {
	set x $msg
    } else {
	close $msg
    }







>







727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
    puts $p2 bye
    puts $p3 bye
    close $p1
    close $p2
    close $p3
    set l
} {{p1 bye done} {p2 bye done} {p3 bye done}}

test socket-4.2 {byte order problems, socket numbers, htons} {socket} {
    set x ok
    if {[catch {tls::socket -server dodo 0x3000} msg]} {
	set x $msg
    } else {
	close $msg
    }
784
785
786
787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
    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 {

	tls::socket -server accept 2820
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 "set x timed_out"]







|



>







791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
    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
	tls::socket -server accept 2820
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 "set x timed_out"]