blob: c3d0b3cdb20e73dc981ebe33ef184fe2b03608cc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
# This file contains tests for the tkMain.c file.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.
#
# TESTFILE INITIALIZATION
#
package require tcltest 2.2; # needed in mode -singleproc 0
# Load the main script main.tcl, which takes care of:
# - setup for the application and the root window
# - importing commands from the tcltest namespace
# - loading of the testutils mechanism along with its utility procs
# - loading of Tk specific test constraints (additionally to constraints
# provided by the package tcltest)
source [file join [tcltest::configure -testdir] main.tcl]
# Ensure a pristine initial window state
resetWindows
#
# TESTS
#
test main-1.1 {StdinProc} -constraints stdio -setup {
set script [makeFile {close stdin; exit} script]
} -body {
exec [interpreter] <$script
} -cleanup {
removeFile script
} -returnCodes ok
test main-2.1 {Tk_MainEx: -encoding option} -constraints stdio -setup {
set script [makeFile {} script]
file delete $script
set f [open $script w]
fconfigure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts $f {puts [string equal \u20AC €]; exit}
close $f
catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]}
} -body {
read $f
} -cleanup {
close $f
removeFile script
} -result "script {} 0\n1\n"
test main-2.2 {Tk_MainEx: -encoding option} -constraints stdio -setup {
set script [makeFile {} script]
file delete $script
set f [open $script w]
fconfigure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts $f {puts [string equal \u20AC €]; exit}
close $f
catch {set f [open "|[list [interpreter] -encoding iso8859-1 script]" r]}
} -body {
read $f
} -cleanup {
close $f
removeFile script
} -result "script {} 0\n0\n"
# Procedure to simulate interactive typing of commands, line by line,
# for test 2.3
proc type {chan script} {
foreach line [split $script \n] {
if {[catch {
puts $chan $line
flush $chan
}]} {
return
}
# Grrr... Behavior depends on this value.
after 1000
}
}
test main-2.3 {Tk_MainEx: -encoding option} -constraints stdio -setup {
set script [makeFile {} script]
file delete $script
set f [open $script w]
fconfigure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
puts $f {puts [string equal \u20AC €]}
close $f
catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]}
} -body {
type $f {
puts $argv
exit
}
gets $f
} -cleanup {
close $f
removeFile script
} -returnCodes ok -result {-enc utf-8 script}
test main-3.1 {Tk_ParseArgv: -help option} -constraints unix -body {
# Run only on unix as Win32 pops up native dialog
exec [interpreter] -help
} -returnCodes error -match glob -result {*application-specific initialization failed: Command-specific options:*}
test main-3.2 {Tk_ParseArgv: -help option} -setup {
set maininterp [interp create]
} -body {
$maininterp eval { set argc 1 ; set argv -help }
load {} Tk $maininterp
} -cleanup {
interp delete $maininterp
} -returnCodes error -match glob -result {Command-specific options:*}
test main-3.3 {Tk_ParseArgv: -help option} -setup {
set maininterp [interp create]
} -body {
# Repeat of 3.2 to catch cleanup, eg Bug 1927135
$maininterp eval { set argc 1 ; set argv -help }
load {} Tk $maininterp
} -cleanup {
interp delete $maininterp
} -returnCodes error -match glob -result {Command-specific options:*}
#
# TESTFILE CLEANUP
#
cleanupTests
|
