diff options
Diffstat (limited to 'tests/main.test')
| -rw-r--r-- | tests/main.test | 40 |
1 files changed, 24 insertions, 16 deletions
diff --git a/tests/main.test b/tests/main.test index 7fd9d73..324b594 100644 --- a/tests/main.test +++ b/tests/main.test @@ -16,7 +16,7 @@ namespace eval ::tcl::test::main { # - tests use testing commands introduced in Tcltest 8.4 testConstraint Tcltest [expr { [llength [package provide Tcltest]] - && [package vsatisfies [package provide Tcltest] 8.4-]}] + && [package vsatisfies [package provide Tcltest] 8.4]}] # Procedure to simulate interactive typing of commands, line by line proc type {chan script} { @@ -66,6 +66,8 @@ namespace eval ::tcl::test::main { } -result [list [interpreter] -script 0]\n test Tcl_Main-1.3 { + Tcl_Main: encoding of arguments: done by system encoding + Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { stdio } -setup { @@ -80,8 +82,10 @@ namespace eval ::tcl::test::main { [encoding convertto [encoding system] \u00c0]]] 0]\n test Tcl_Main-1.4 { + Tcl_Main: encoding of arguments: done by system encoding + Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { - stdio + stdio tempNotWin } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script catch {set f [open "|[list [interpreter] script \u20ac]" r]} @@ -94,6 +98,8 @@ namespace eval ::tcl::test::main { [encoding convertto [encoding system] \u20ac]]] 0]\n test Tcl_Main-1.5 { + Tcl_Main: encoding of script name: system encoding loss + Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { stdio } -setup { @@ -108,8 +114,10 @@ namespace eval ::tcl::test::main { [encoding convertto [encoding system] \u00c0]]] {} 0]\n test Tcl_Main-1.6 { + Tcl_Main: encoding of script name: system encoding loss + Note the shortcoming explained in Tcl Feature Request 491789 } -constraints { - stdio + stdio tempNotWin } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac catch {set f [open "|[list [interpreter] \u20ac]" r]} @@ -129,7 +137,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -150,7 +158,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -171,7 +179,7 @@ namespace eval ::tcl::test::main { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 + chan configure $f -encoding utf-8 puts $f {puts [list $argv0 $argv $tcl_interactive]} puts -nonewline $f {puts [string equal \u20ac } puts $f "\u20ac]" @@ -592,7 +600,7 @@ namespace eval ::tcl::test::main { catch {set f [open "|[list [interpreter]]" w+]} } -body { type $f { - fconfigure stdin -blocking 0 + chan configure stdin -blocking 0 puts SUCCESS } list [catch {gets $f} line] $line @@ -606,19 +614,19 @@ namespace eval ::tcl::test::main { exec } -setup { catch {set f [open "|[list [interpreter]]" w+]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { - type $f "fconfigure stdin -eofchar \\032 + type $f "chan configure stdin -eofchar \\032 if 1 \{\n\032" variable wait - fileevent $f readable \ + chan event $f readable \ [list set [namespace which -variable wait] "child exit"] set id [after 2000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { - if {[string equal timeout $wait] && [testConstraint unix]} { + if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f @@ -631,17 +639,17 @@ namespace eval ::tcl::test::main { } -setup { set cmd {makeFile "if 1 \{" script} catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { variable wait - fileevent $f readable \ + chan event $f readable \ [list set [namespace which -variable wait] "child exit"] set id [after 2000 [list set [namespace which -variable wait] timeout]] vwait [namespace which -variable wait] after cancel $id set wait } -cleanup { - if {[string equal timeout $wait] && [testConstraint unix]} { + if {$wait eq "timeout" && [testConstraint unix]} { exec kill [pid $f] } close $f @@ -748,7 +756,7 @@ namespace eval ::tcl::test::main { exec Tcltest } -setup { catch {set f [open "|[list [interpreter]]" w+]} - catch {fconfigure $f -blocking 0} + catch {chan configure $f -blocking 0} } -body { type $f "testsetmainloop after 2000 testexitmainloop @@ -983,7 +991,7 @@ namespace eval ::tcl::test::main { } -body { exec [interpreter] << { testsetmainloop - fconfigure stdin -blocking 0 + chan configure stdin -blocking 0 testexitmainloop } >& result set f [open result] |