Check-in [7f3358aca3]
Overview
Comment:Fix test 2.3.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7f3358aca3af4b85854df6800a47fdeb51c1de75
User & Date: awb on 2000-06-02 21:50:44
Other Links: manifest | tags
Context
2000-06-02
22:26
Fix some more tests. check-in: f1e28695f2 user: awb tags: trunk
21:50
Fix test 2.3. check-in: 7f3358aca3 user: awb tags: trunk
21:44
Fix test 2.2. check-in: a1d3dcc242 user: awb 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.4 2000/06/02 21:44:59 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.5 2000/06/02 21:50:44 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
327
328
329
330
331
332
333
334
335
336
337
338
339

340

341
342
343
344
345
346
347
348
349
350
351
352
353
354
355


356
357
358
359
360
361
362
        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]

	proc accept {file addr port} {
            global x
            puts "[gets $file] $addr"
            close $file
            set x done
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f x
    if {[catch {tls::socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {


        set x $sock
    } else {
        puts $sock hello
	catch {flush $sock}
        lappend x [gets $f]
        close $sock
    }







|





>
|
>














|
>
>







327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
        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} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
	set timer [after 2000 "set x done"]
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2830 \]"
    puts $f {
	proc accept {file addr port} {
            global x
            puts "[gets $file] $addr"
            close $file
            set x done
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f x
    if {[catch {tls::socket -myaddr 127.0.0.1 \
	-certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 2830} sock]} {
        set x $sock
    } else {
        puts $sock hello
	catch {flush $sock}
        lappend x [gets $f]
        close $sock
    }