Diff

Differences From Artifact [1116f46566]:

To Artifact [eb8672a93e]:


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