diff options
Diffstat (limited to 'tests/ioCmd.test')
| -rw-r--r-- | tests/ioCmd.test | 74 |
1 files changed, 49 insertions, 25 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 93815c9..678700f 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -17,12 +17,11 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } +source [file join [file dirname [info script]] tcltests.tcl] ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests - # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] @@ -208,7 +207,7 @@ test iocmd-7.5 {close command} -setup { proc expectedOpts {got extra} { set basicOpts { - -blocking -buffering -buffersize -encoding -eofchar -translation + -blocking -buffering -buffersize -encoding -eofchar -profile -translation } set opts [list {*}$basicOpts {*}$extra] lset opts end [string cat "or " [lindex $opts end]] @@ -241,33 +240,33 @@ test iocmd-8.7 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] - fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 + fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 -profile tcl8 fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -translation lf} +} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf} test iocmd-8.8 {fconfigure command} -setup { file delete $path(test1) set x {} } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ - -eofchar {} -encoding utf-16 + -eofchar {} -encoding utf-16 -profile tcl8 lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] } -cleanup { catch {close $f1} -} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -translation lf}} +} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}} test iocmd-8.9 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation binary -buffering none -buffersize 4040 \ - -eofchar {} -encoding binary + -eofchar {} -encoding binary -profile tcl8 fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf} +} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -profile tcl8 -translation lf} test iocmd-8.10 {fconfigure command} -returnCodes error -body { fconfigure a b } -result {can not find channel named "a"} @@ -294,7 +293,7 @@ removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 -test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup { +test iocmd-8.15 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} @@ -306,7 +305,7 @@ test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOr close $srv unset cli srv port rename iocmdSRV {} -} -returnCodes error -result [expectedOpts "-blah" {-connecting -peername -sockname}] +} -returnCodes error -result [expectedOpts "-blah" {-connecting -keepalive -nodelay -peername -sockname}] test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] @@ -369,6 +368,31 @@ test iocmd-8.20 {fconfigure command / win console channel} -constraints {nonPort } -returnCodes error -result [expectedOpts "-blah" {-inputmode}] # TODO: Test parsing of serial channel options (nonPortable, since requires an # open channel to work with). +test iocmd-8.21 {fconfigure command / -nocomplainencoding 0 error} -constraints { + deprecated obsolete +} -setup { + # I don't know how else to open the console, but this is non-portable + set console stdin +} -body { + fconfigure $console -nocomplainencoding 0 +} -returnCodes error -result "bad value for -nocomplainencoding: only true allowed" +test iocmd-8.22 {fconfigure command / -nocomplainencoding 0, no error if -strictencoding already defined} -setup { + set console stdin + set oldprofile [fconfigure $console -profile] +} -constraints { + obsolete +} -body { + fconfigure $console -strictencoding 1 + fconfigure $console -nocomplainencoding 0 + fconfigure $console -nocomplainencoding +} -cleanup { + fconfigure $console -strictencoding $oldmode +} -result 0 + + +test iocmd-8.23 {fconfigure -profile badprofile} -body { + fconfigure stdin -profile froboz +} -returnCodes error -result {bad profile name "froboz": must be replace, strict, or tcl8} test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $::errorCode @@ -700,7 +724,7 @@ test iocmd-20.1 {chan, unknown method} -body { } -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *} # --- --- --- --------- --------- --------- -# chan create, and method "initalize" +# chan create, and method "initialize" test iocmd-21.0 {chan create, wrong#args, not enough} { catch {chan create} msg @@ -710,12 +734,12 @@ test iocmd-21.1 {chan create, wrong#args, too many} { catch {chan create a b c} msg set msg } {wrong # args: should be "chan create mode cmdprefix"} -test iocmd-21.2 {chan create, invalid r/w mode, empty} { - proc foo {} {} - catch {chan create {} foo} msg +test iocmd-21.2 {chan create, r/w mode empty} { + proc foo {cmd args} { return {initialize finalize watch} } + set chan [chan create {} foo] + close $chan rename foo {} - set msg -} {bad mode list: is empty} +} {} test iocmd-21.3 {chan create, invalid r/w mode, bad string} { proc foo {} {} catch {chan create {c} foo} msg @@ -1069,7 +1093,7 @@ test iocmd-23.1 {chan read, regular data return} -match glob -body { rename foo {} set res } -result {{read rc* 4096} {read rc* 4096} snarfsnarf} -test iocmd-23.2 {chan read, bad data return, to much} -match glob -body { +test iocmd-23.2 {chan read, bad data return, too much} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track @@ -1384,7 +1408,7 @@ test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { close $c rename foo {} set res -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -profile * -translation {auto *}}} test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} @@ -1393,7 +1417,7 @@ test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -profile * -translation {auto *}}} test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { @@ -1405,7 +1429,7 @@ test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -profile * -translation {auto *} -bar foo -snarf x}} test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { @@ -2380,7 +2404,7 @@ test iocmd.tf-23.1 {chan read, regular data return} -match glob -body { rename foo {} set res } -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf} -test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body { +test iocmd.tf-23.2 {chan read, bad data return, too much} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track @@ -2926,7 +2950,7 @@ test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body rename foo {} set res } -constraints {testchannel thread} \ - -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} + -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *}}} test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} @@ -2939,7 +2963,7 @@ test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { rename foo {} set res } -constraints {testchannel thread} \ - -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} + -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *}}} test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { @@ -2955,7 +2979,7 @@ test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { rename foo {} set res } -constraints {testchannel thread} \ - -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} + -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *} -bar foo -snarf x}} test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { |