Overview
Comment: | Fix test 2.2. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
a1d3dcc242eac5a287a1e5a133f1cdbd |
User & Date: | awb on 2000-06-02 21:44:59 |
Other Links: | manifest | tags |
Context
2000-06-02
| ||
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 | |
20:45 | *** empty log message *** check-in: 570604a410 user: awb tags: trunk | |
Changes
Modified tests/tlsIo.test from [eb8672a93e] to [6a79fb9151].
1 2 3 4 5 6 7 8 9 10 11 12 | # 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. # | | | 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 |
︙ | ︙ | |||
65 66 67 68 69 70 71 72 73 74 75 76 77 78 | if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Load the tls package package require tls # Some tests require the testthread command set ::tcltest::testConstraints(testthread) \ [expr {[info commands testthread] != {}}] # | > > > > > > | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Load the tls package package require tls set serverCert [file join $::tcltest::testsDirectory certs server.pem] set clientCert [file join $::tcltest::testsDirectory certs client.pem] set caCert [file join $::tcltest::testsDirectory certs cacert.pem] set serverKey [file join $::tcltest::testsDirectory certs skey.pem] set clientKey [file join $::tcltest::testsDirectory certs ckey.pem] # Some tests require the testthread command set ::tcltest::testConstraints(testthread) \ [expr {[info commands testthread] != {}}] # |
︙ | ︙ | |||
282 283 284 285 286 287 288 | if [info exists port] { incr port } else { set port [expr 2048 + [pid]%1024] } | | > | > | > > | < | 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 | 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} { 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 2829 \]" puts $f { proc accept {file addr port} { global x puts "[gets $file] $port" 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 global port if {[catch {tls::socket -myport $port \ -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 2829} sock]} { set x $sock catch {close [tls::socket 127.0.0.1 2829]} } else { puts $sock hello flush $sock lappend x [gets $f] close $sock } close $f |
︙ | ︙ | |||
343 344 345 346 347 348 349 | 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 | | | 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | 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 } close $f set x } {ready {hello 127.0.0.1}} |
︙ | ︙ |