summaryrefslogtreecommitdiffstats
path: root/tests/main.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/main.test')
-rw-r--r--tests/main.test155
1 files changed, 120 insertions, 35 deletions
diff --git a/tests/main.test b/tests/main.test
index 40c0453..324b594 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -6,15 +6,7 @@ if {[catch {package require tcltest 2.0.2}]} {
}
namespace eval ::tcl::test::main {
-
- namespace import ::tcltest::test
- namespace import ::tcltest::testConstraint
- namespace import ::tcltest::interpreter
- namespace import ::tcltest::cleanupTests
- namespace import ::tcltest::makeFile
- namespace import ::tcltest::removeFile
- namespace import ::tcltest::temporaryDirectory
- namespace import ::tcltest::workingDirectory
+ namespace import ::tcltest::*
# Is [exec] defined?
testConstraint exec [llength [info commands exec]]
@@ -137,6 +129,72 @@ namespace eval ::tcl::test::main {
} -result [list [list [encoding convertfrom [encoding system] \
[encoding convertto [encoding system] \u20ac]]] {} 0]\n
+ test Tcl_Main-1.7 {
+ Tcl_Main: startup script - -encoding option
+ } -constraints {
+ stdio
+ } -setup {
+ set script [makeFile {} script]
+ file delete $script
+ set f [open $script w]
+ chan configure $f -encoding utf-8
+ puts $f {puts [list $argv0 $argv $tcl_interactive]}
+ puts -nonewline $f {puts [string equal \u20ac }
+ puts $f "\u20ac]"
+ close $f
+ catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]}
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result [list script {} 0]\n1\n
+
+ test Tcl_Main-1.8 {
+ Tcl_Main: startup script - -encoding option - mismatched encodings
+ } -constraints {
+ stdio
+ } -setup {
+ set script [makeFile {} script]
+ file delete $script
+ set f [open $script w]
+ chan configure $f -encoding utf-8
+ puts $f {puts [list $argv0 $argv $tcl_interactive]}
+ puts -nonewline $f {puts [string equal \u20ac }
+ puts $f "\u20ac]"
+ close $f
+ catch {set f [open "|[list [interpreter] -encoding ascii script]" r]}
+ } -body {
+ read $f
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result [list script {} 0]\n0\n
+
+ test Tcl_Main-1.9 {
+ Tcl_Main: startup script - -encoding option - no abbrevation
+ } -constraints {
+ stdio
+ } -setup {
+ set script [makeFile {} script]
+ file delete $script
+ set f [open $script w]
+ chan configure $f -encoding utf-8
+ puts $f {puts [list $argv0 $argv $tcl_interactive]}
+ puts -nonewline $f {puts [string equal \u20ac }
+ puts $f "\u20ac]"
+ close $f
+ catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]}
+ } -body {
+ type $f {
+ puts $argv
+ }
+ list [catch {gets $f} line] $line
+ } -cleanup {
+ close $f
+ removeFile script
+ } -result {0 {-enc utf-8 script}}
+
# Tests Tcl_Main-2.*: application-initialization procedure
test Tcl_Main-2.1 {
@@ -498,24 +556,24 @@ namespace eval ::tcl::test::main {
\nExit MainLoop\nIn exit\neven 0\n"
test Tcl_Main-4.5 {
- Tcl_Main: Bug 1481986
+ Tcl_Main: Bug 1481986
} -constraints {
- exec Tcltest
+ exec Tcltest
} -setup {
- set rc [makeFile {
- testsetmainloop
- after 0 {puts "Event callback"}
- } rc]
+ set rc [makeFile {
+ testsetmainloop
+ after 0 {puts "Event callback"}
+ } rc]
} -body {
- set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]
- after 1000
- type $f {puts {Interactive output}
- exit
- }
- read $f
+ set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]
+ after 1000
+ type $f {puts {Interactive output}
+ exit
+ }
+ read $f
} -cleanup {
- catch {close $f}
- removeFile rc
+ catch {close $f}
+ removeFile rc
} -result "Event callback\nInteractive output\n"
# Tests Tcl_Main-5.*: interactive operations
@@ -542,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
@@ -556,20 +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]
- && [string equal unix $::tcl_platform(platform)]} {
+ if {$wait eq "timeout" && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
@@ -582,18 +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]
- && [string equal unix $::tcl_platform(platform)]} {
+ if {$wait eq "timeout" && [testConstraint unix]} {
exec kill [pid $f]
}
close $f
@@ -700,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
@@ -761,6 +817,20 @@ namespace eval ::tcl::test::main {
file delete result
} -result "Exit MainLoop\nIn exit\neven 0\n"
+ test Tcl_Main-5.13 {
+ Bug 1775878
+ } -constraints {
+ exec
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ } -body {
+ type $f "puts \\"
+ type $f return
+ list [catch {gets $f} line] $line
+ } -cleanup {
+ close $f
+ } -result [list 0 return]
+
# Tests Tcl_Main-6.*: interactive operations with prompts
test Tcl_Main-6.1 {
@@ -921,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]
@@ -1144,6 +1214,21 @@ namespace eval ::tcl::test::main {
file delete result
} -result "1\nExit MainLoop\n"
+ test Tcl_Main-8.13 {
+ Bug 1775878
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ } -body {
+ exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "pwd\nExit MainLoop\n"
+
# Tests Tcl_Main-9.*: Prompt operations
test Tcl_Main-9.1 {
generated by cgit v0.12 at 2024-08-24 03:42:38 (GMT)