OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [winPipe.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
#
2 
# winPipe.test --
3 
#
4 
# This file contains a collection of tests for tclWinPipe.c
5 
 
6 
# Sourcing this file into Tcl runs the tests and generates output for
7 
# errors.  No output means no errors were found.
8 
#
9 
# Copyright (c) 1996 Sun Microsystems, Inc.
10 
#
11 
# See the file "license.terms" for information on usage and redistribution
12 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 
#
14 
# RCS: @(#) $Id: winPipe.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
15 
 
16 
if {$tcl_platform(platform) != "windows"} {
17 
    return
18 
}
19 
 
20 
set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
21 
set cat16 [file join  $bindir cat16.exe]
22 
set cat32 [file join $bindir cat32.exe]
23 
 
24 
if {[string compare test [info procs test]] == 1} then {source defs}
25 
 
26 
if [catch {puts console1 ""}] {
27 
    set testConfig(AllocConsole) 1
28 
} else {
29 
    set testConfig(.console) 1
30 
}
31 
 
32 
set big aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n
33 
append big $big
34 
append big $big
35 
append big $big
36 
append big $big
37 
append big $big
38 
append big $big
39 
 
40 
set f [open "little" w]
41 
puts -nonewline $f "little"
42 
close $f
43 
 
44 
set f [open "big" w]
45 
puts -nonewline $f $big
46 
close $f
47 
 
48 
proc contents {file} {
49 
    set f [open $file r]
50 
    set r [read $f]
51 
    close $f
52 
    set r
53 
}
54 
 
55 
if {$testConfig(stdio) && [file exists $cat32]} {
56 
test winpipe-1.1 {32 bit comprehensive tests: from little file} {
57 
    exec $cat32 < little > stdout 2> stderr
58 
    list [contents stdout] [contents stderr]
59 
} "little stderr32"
60 
test winpipe-1.2 {32 bit comprehensive tests: from big file} {
61 
    exec $cat32 < big > stdout 2> stderr
62 
    list [contents stdout] [contents stderr]
63 
} "{$big} stderr32"
64 
test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {nt} {
65 
    exec more < little | $cat32 > stdout 2> stderr
66 
    list [contents stdout] [contents stderr]
67 
} "{little\n} stderr32"
68 
test winpipe-1.4 {32 bit comprehensive tests: a little from pipe} {95} {
69 
    exec more < little |& $cat32 > stdout 2> stderr
70 
    list [contents stdout] [contents stderr]
71 
} "{\nlittle} stderr32"
72 
test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {nt} {
73 
    exec more < big | $cat32 > stdout 2> stderr
74 
    list [contents stdout] [contents stderr]
75 
} "{$big} stderr32"
76 
test winpipe-1.6 {32 bit comprehensive tests: a lot from pipe} {95} {
77 
    exec command /c type big |& $cat32 > stdout 2> stderr
78 
    list [contents stdout] [contents stderr]
79 
} "{$big} stderr32"
80 
test winpipe-1.7 {32 bit comprehensive tests: from console} {AllocConsole} {
81 
    # would block waiting for human input
82 
} {}
83 
test winpipe-1.8 {32 bit comprehensive tests: from NUL} {
84 
    exec $cat32 < nul > stdout 2> stderr
85 
    list [contents stdout] [contents stderr]
86 
} "{} stderr32"
87 
test winpipe-1.9 {32 bit comprehensive tests: from socket} {
88 
    # doesn't work
89 
} {}
90 
test winpipe-1.10 {32 bit comprehensive tests: from nowhere} {.console} {
91 
    exec $cat32 > stdout 2> stderr
92 
    list [contents stdout] [contents stderr]
93 
} "{} stderr32"
94 
test winpipe-1.11 {32 bit comprehensive tests: from file handle} {
95 
    set f [open "little" r]
96 
    exec $cat32 <@$f > stdout 2> stderr
97 
    close $f
98 
    list [contents stdout] [contents stderr]
99 
} "little stderr32"
100 
test winpipe-1.12 {32 bit comprehensive tests: read from application} {
101 
    set f [open "|$cat32 < little" r]
102 
    gets $f line
103 
    catch {close $f} msg
104 
    list $line $msg
105 
} "little stderr32"
106 
test winpipe-1.13 {32 bit comprehensive tests: a little to file} {
107 
    exec $cat32 < little > stdout 2> stderr
108 
    list [contents stdout] [contents stderr]
109 
} "little stderr32"
110 
test winpipe-1.14 {32 bit comprehensive tests: a lot to file} {
111 
    exec $cat32 < big > stdout 2> stderr
112 
    list [contents stdout] [contents stderr]
113 
} "{$big} stderr32"
114 
test winpipe-1.15 {32 bit comprehensive tests: a little to pipe} {nt} {
115 
    exec $cat32 < little | more > stdout 2> stderr
116 
    list [contents stdout] [contents stderr]
117 
} "{little\n} stderr32"
118 
test winpipe-1.16 {32 bit comprehensive tests: a little to pipe} {95} {
119 
    exec $cat32 < little | more > stdout 2> stderr
120 
    list [contents stdout] [contents stderr]
121 
} "{\nlittle} stderr32"
122 
test winpipe-1.17 {32 bit comprehensive tests: a lot to pipe} {nt} {
123 
    exec $cat32 < big | more > stdout 2> stderr
124 
    list [contents stdout] [contents stderr]
125 
} "{$big\n} stderr32"
126 
test winpipe-1.18 {32 bit comprehensive tests: a lot to pipe} {95} {
127 
    exec $cat32 < big | more > stdout 2> stderr
128 
    list [contents stdout] [contents stderr]
129 
} "{\n$big} stderr32"
130 
test winpipe-1.19 {32 bit comprehensive tests: to console} {
131 
    catch {exec $cat32 << "You should see this\n" >@stdout} msg
132 
    set msg
133 
} stderr32
134 
test winpipe-1.20 {32 bit comprehensive tests: to NUL} {
135 
    # some apps hang when sending a large amount to NUL.  $cat32 isn't one.
136 
    catch {exec $cat32 < big > nul} msg
137 
    set msg
138 
} stderr32
139 
test winpipe-1.21 {32 bit comprehensive tests: to nowhere} {.console} {
140 
    exec $cat32 < big >&@stdout
141 
} {}
142 
test winpipe-1.22 {32 bit comprehensive tests: to file handle} {
143 
    set f1 [open "stdout" w]
144 
    set f2 [open "stderr" w]
145 
    exec $cat32 < little >@$f1 2>@$f2
146 
    close $f1
147 
    close $f2
148 
    list [contents stdout] [contents stderr]
149 
} "little stderr32"
150 
test winpipe-1.23 {32 bit comprehensive tests: write to application} {
151 
    set f [open "|$cat32 > stdout" w]
152 
    puts -nonewline $f "foo"
153 
    catch {close $f} msg
154 
    list [contents stdout] $msg
155 
} "foo stderr32"
156 
test winpipe-1.24 {32 bit comprehensive tests: read/write application} {
157 
    set f [open "|$cat32" r+]
158 
    puts $f $big
159 
    puts $f \032
160 
    flush $f
161 
    set r [read $f 64]
162 
    catch {close $f}
163 
    set r
164 
} "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
165 
}
166 
 
167 
set stderr16 "stderr16"
168 
if {$tcl_platform(os) == "Win32s"} {
169 
    set stderr16 "{}"
170 
}
171 
if [file exists $cat16] {
172 
test winpipe-2.1 {16 bit comprehensive tests: from little file} {
173 
    exec $cat16 < little > stdout 2> stderr
174 
    list [contents stdout] [contents stderr]
175 
} "little $stderr16"
176 
test winpipe-2.2 {16 bit comprehensive tests: from big file} {
177 
    exec $cat16 < big > stdout 2> stderr
178 
    list [contents stdout] [contents stderr]
179 
} "{$big} $stderr16"
180 
test winpipe-2.3 {16 bit comprehensive tests: a little from pipe} {nt} {
181 
    exec more < little | $cat16 > stdout 2> stderr
182 
    list [contents stdout] [contents stderr]
183 
} "{little\n} stderr16"
184 
test winpipe-2.4 {16 bit comprehensive tests: a little from pipe} {95} {
185 
    exec more < little | $cat16 > stdout 2> stderr
186 
    list [contents stdout] [contents stderr]
187 
} "{\nlittle} stderr16"
188 
test winpipe-2.5 {16 bit comprehensive tests: a lot from pipe} {nt} {
189 
    exec $cat16 < big | $cat16 > stdout 2> stderr
190 
    list [contents stdout] [contents stderr]
191 
} "{$big} stderr16stderr16"
192 
test winpipe-2.6 {16 bit comprehensive tests: a lot from pipe} {95} {
193 
    exec more < big | $cat16 > stdout 2> stderr
194 
    list [contents stdout] [contents stderr]
195 
} "{\n$big} stderr16"
196 
test winpipe-2.7 {16 bit comprehensive tests: from console} {AllocConsole} {
197 
    # would block waiting for human input
198 
} {}
199 
test winpipe-2.8 {16 bit comprehensive tests: from NUL} {nt} {
200 
    exec $cat16 < nul > stdout 2> stderr
201 
    list [contents stdout] [contents stderr]
202 
} "{} stderr16"
203 
test winpipe-2.9 {16 bit comprehensive tests: from socket} {
204 
    # doesn't work
205 
} {}
206 
test winpipe-2.10 {16 bit comprehensive tests: from nowhere} {.console} {
207 
    exec $cat16 > stdout 2> stderr
208 
    list [contents stdout] [contents stderr]
209 
} "{} stderr16"
210 
test winpipe-2.11 {16 bit comprehensive tests: from file handle} {
211 
    set f [open "little" r]
212 
    exec $cat16 <@$f > stdout 2> stderr
213 
    close $f
214 
    list [contents stdout] [contents stderr]
215 
} "little $stderr16"
216 
test winpipe-2.12 {16 bit comprehensive tests: read from application} {
217 
    set f [open "|$cat16 < little" r]
218 
    gets $f line
219 
    catch {close $f} msg
220 
    list $line $msg
221 
} "little $stderr16"
222 
test winpipe-2.13 {16 bit comprehensive tests: a little to file} {
223 
    exec $cat16 < little > stdout 2> stderr
224 
    list [contents stdout] [contents stderr]
225 
} "little $stderr16"
226 
test winpipe-2.14 {16 bit comprehensive tests: a lot to file} {
227 
    exec $cat16 < big > stdout 2> stderr
228 
    list [contents stdout] [contents stderr]
229 
} "{$big} $stderr16"
230 
test winpipe-2.15 {16 bit comprehensive tests: a little to pipe} {nt} {
231 
    catch {exec $cat16 < little | more > stdout 2> stderr}
232 
    list [contents stdout] [contents stderr]
233 
} "{little\n} stderr16"
234 
test winpipe-2.16 {16 bit comprehensive tests: a little to pipe} {95} {
235 
    exec $cat16 < little | more > stdout 2> stderr
236 
    list [contents stdout] [contents stderr]
237 
} "{\nlittle} stderr16"
238 
test winpipe-2.17 {16 bit comprehensive tests: a lot to pipe} {nt} {
239 
    catch {exec $cat16 < big | more > stdout 2> stderr}
240 
    list [contents stdout] [contents stderr]
241 
} "{$big\n} stderr16"
242 
test winpipe-2.18 {16 bit comprehensive tests: a lot to pipe} {95} {
243 
    exec $cat16 < big | more > stdout 2> stderr
244 
    list [contents stdout] [contents stderr]
245 
} "{\n$big} stderr16"
246 
test winpipe-2.19 {16 bit comprehensive tests: to console} {
247 
    catch {exec $cat16 << "You should see this\n" >@stdout} msg
248 
    set msg
249 
} [lindex $stderr16 0]
250 
test winpipe-2.20 {16 bit comprehensive tests: to NUL} {nt} {
251 
    # some apps hang when sending a large amount to NUL.  cat16 isn't one.
252 
    catch {exec $cat16 < big > nul} msg
253 
    set msg
254 
} stderr16
255 
test winpipe-2.21 {16 bit comprehensive tests: to nowhere} {.console} {
256 
    exec $cat16 < big >&@stdout
257 
} {}
258 
test winpipe-2.22 {16 bit comprehensive tests: to file handle} {
259 
    set f1 [open "stdout" w]
260 
    set f2 [open "stderr" w]
261 
    exec $cat16 < little >@$f1 2>@$f2
262 
    close $f1
263 
    close $f2
264 
    list [contents stdout] [contents stderr]
265 
} "little $stderr16"
266 
test winpipe-2.23 {16 bit comprehensive tests: write to application} {!win32s} {
267 
    set f [open "|$cat16 > stdout" w]
268 
    puts -nonewline $f "foo"
269 
    catch {close $f} msg
270 
    list [contents stdout] $msg
271 
} "foo stderr16"
272 
test winpipe-2.24 {16 bit comprehensive tests: read/write application} {nt} {
273 
    set f [open "|$cat16" r+]
274 
    puts $f $big
275 
    puts $f \032
276 
    flush $f
277 
    set r [read $f 64]
278 
    catch {close $f}
279 
    set r
280 
} "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
281 
}
282 
 
283 
test winpipe-4.1 {Tcl_WaitPid} {nt} {
284 
    proc readResults {f} {
285 
        global x result
286 
        if { [eof $f] } {
287 
            close $f
288 
            set x 1
289 
        } else {
290 
            set line [read $f ]
291 
            set result "$result$line"
292 
        }
293 
    }
294 
 
295 
    set f [open "|$cat32 < big 2> stderr" r]
296 
    fconfigure $f  -buffering none -blocking 0
297 
    fileevent $f readable "readResults $f"
298 
    set x 0
299 
    set result ""
300 
    vwait x
301 
    list $result $x [contents stderr]
302 
} "{$big} 1 stderr32"
303 
 
304 
close [open nothing w]
305 
 
306 
catch {set env_tmp $env(TMP)}
307 
catch {set env_temp $env(TEMP)}
308 
 
309 
set env(TMP) c:/
310 
set env(TEMP) c:/
311 
 
312 
test winpipe-3.1 {TclpCreateTempFile: cleanup temp files} {
313 
    set x {}
314 
    set existing [glob -nocomplain c:/tcl*.tmp]
315 
    exec $tcltest < nothing
316 
    foreach p [glob -nocomplain c:/tcl*.tmp] {
317 
        if {[lsearch $existing $p] != -1} {
318 
            lappend x $p
319 
        }
320 
    }
321 
    set x
322 
} {}
323 
test winpipe-3.2 {TclpCreateTempFile: TMP and TEMP not defined} {
324 
    set tmp $env(TMP)
325 
    set temp $env(TEMP)
326 
    unset env(TMP)
327 
    unset env(TEMP)
328 
    exec $tcltest < nothing
329 
    set env(TMP) $tmp
330 
    set env(TEMP) $temp
331 
    set x {}
332 
} {}
333 
test winpipe-3.3 {TclpCreateTempFile: TMP specifies non-existent directory} {
334 
    set tmp $env(TMP)
335 
    set env(TMP) snarky
336 
    exec $tcltest < nothing
337 
    set env(TMP) $tmp
338 
    set x {}
339 
} {}
340 
test winpipe-3.3 {TclpCreateTempFile: TEMP specifies non-existent directory} {
341 
    set tmp $env(TMP)
342 
    set temp $env(TEMP)
343 
    unset env(TMP)
344 
    set env(TEMP) snarky
345 
    exec $tcltest < nothing
346 
    set env(TMP) $tmp
347 
    set env(TEMP) $temp
348 
    set x {}
349 
} {}
350 
 
351 
makeFile {
352 
    puts "[list $argv0 $argv]"
353 
} echoArgs.tcl
354 
 
355 
test winpipe-4.1 {BuildCommandLine: null arguments} {
356 
    exec $tcltest echoArgs.tcl foo "" bar
357 
} {echoArgs.tcl {foo {} bar}}
358 
test winpipe-4.1 {BuildCommandLine: null arguments} {
359 
    exec $tcltest echoArgs.tcl foo \" bar
360 
} {echoArgs.tcl {foo {"} bar}}
361 
 
362 
# restore old values fro env(TMP) and env(TEMP)
363 
 
364 
if {[catch {set env(TMP) $env_tmp}]} {
365 
    unset $env(TMP)
366 
}
367 
if {[catch {set env(TEMP) $env_temp}]} {
368 
    unset $env(TEMP)
369 
}
370 
 
371 
file delete big little stdout stderr nothing dummy.tcl

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.