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-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 $
# 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
|
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
|
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
|
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
|
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
|
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} {
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 [socket 127.0.0.1 2828]
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
|
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
|
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} {
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"]
|
| ︙ | | |