Diff
Not logged in

Differences From Artifact [27dddea204]:

To Artifact [0d2d83082c]:


9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.45.2.22 2008/04/15 19:19:37 dgp Exp $

if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
namespace eval ::tcl::test::io {
    namespace import ::tcltest::*







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.45.2.23 2008/05/31 21:02:14 dgp Exp $

if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
namespace eval ::tcl::test::io {
    namespace import ::tcltest::*
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 100000
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 10000000
    lappend l [fconfigure $f -buffersize]
    close $f
    set l
} {4096 10000 1 1 1 100000 100000}
test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
    # This test crashes the interp if Bug #427196 is not fixed

    set chan [open [info script] r]
    fconfigure $chan -buffersize 10
    set var [read $chan 2]
    fconfigure $chan -buffersize 32







|







4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 100000
    lappend l [fconfigure $f -buffersize]
    fconfigure $f -buffersize 10000000
    lappend l [fconfigure $f -buffersize]
    close $f
    set l
} {4096 10000 1 1 1 100000 1048576}
test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
    # This test crashes the interp if Bug #427196 is not fixed

    set chan [open [info script] r]
    fconfigure $chan -buffersize 10
    set var [read $chan 2]
    fconfigure $chan -buffersize 32
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
    lappend x [fblocked $f1]
    lappend x [eof $f1]
    lappend x [gets $f1]
    lappend x [eof $f1]
    close $f1
    set x
} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -buffersize -10
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 4096
test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -buffersize 10000000
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 4096
test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -buffersize 40000
    set x [fconfigure $f -buffersize]
    close $f
    set x







|






|
|






|







5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
    lappend x [fblocked $f1]
    lappend x [eof $f1]
    lappend x [gets $f1]
    lappend x [eof $f1]
    close $f1
    set x
} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -buffersize -10
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 1
test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -buffersize 10000000
    set x [fconfigure $f -buffersize]
    close $f
    set x
} 1048576
test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -buffersize 40000
    set x [fconfigure $f -buffersize]
    close $f
    set x
7047
7048
7049
7050
7051
7052
7053

7054
7055
7056
7057
7058
7059
7060
    vwait ::forever
    catch {after cancel $token}
    set ::forever
} -cleanup {
    close $pipe
    rename ::done {}
    after 1000;			# Give Windows time to kill the process

    catch {removeFile out}
    catch {removeFile err}
    catch {unset ::forever}
} -result OK
test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
    set err [makeFile {} err]
    set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]







>







7047
7048
7049
7050
7051
7052
7053
7054
7055
7056
7057
7058
7059
7060
7061
    vwait ::forever
    catch {after cancel $token}
    set ::forever
} -cleanup {
    close $pipe
    rename ::done {}
    after 1000;			# Give Windows time to kill the process
    catch {close $out}
    catch {removeFile out}
    catch {removeFile err}
    catch {unset ::forever}
} -result OK
test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
    set err [makeFile {} err]
    set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]