summaryrefslogtreecommitdiffstats
path: root/tests/ioCmd.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2023-05-24 16:02:24 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2023-05-24 16:02:24 (GMT)
commit29225e440c7dfc3b4fb54d8bb5a8b32fd9604d6f (patch)
tree76a21d1b72f69d7f7218eb0332f9d2afbed472d5 /tests/ioCmd.test
parent4a3c559932945a74fed481561274ceedc4afe555 (diff)
parent70a3d08fc4eb639c20c5613ea5952a0dfdd5e935 (diff)
downloadtcl-29225e440c7dfc3b4fb54d8bb5a8b32fd9604d6f.zip
tcl-29225e440c7dfc3b4fb54d8bb5a8b32fd9604d6f.tar.gz
tcl-29225e440c7dfc3b4fb54d8bb5a8b32fd9604d6f.tar.bz2
merge core-8-branch
Diffstat (limited to 'tests/ioCmd.test')
-rw-r--r--tests/ioCmd.test74
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} {