Diff
Not logged in

Differences From Artifact [258c92e9fb]:

To Artifact [cfc5c5df02]:


40
41
42
43
44
45
46

47
48
49
50
51
52
53
testConstraint openpipe         1
testConstraint fileevent        [llength [info commands fileevent]]
testConstraint fcopy            [llength [info commands fcopy]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]


# You need a *very* special environment to do some tests.  In
# particular, many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.







>







40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
testConstraint openpipe         1
testConstraint fileevent        [llength [info commands fileevent]]
testConstraint fcopy            [llength [info commands fcopy]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint testobj		[llength [info commands testobj]]

# You need a *very* special environment to do some tests.  In
# particular, many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
4281
4282
4283
4284
4285
4286
4287







4288
4289
4290
4291
4292
4293
4294
    puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    close $f
    set f [open $path(test3)]
    set x [gets $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}







test io-33.5 {Tcl_Gets with long line} {
    set f [open $path(test3)]
    set x [gets $f y]
    close $f
    list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test io-33.6 {Tcl_Gets and end of file} {







>
>
>
>
>
>
>







4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
    puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    close $f
    set f [open $path(test3)]
    set x [gets $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
set f [open $path(test3) w]
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
close $f
test io-33.5 {Tcl_Gets with long line} {
    set f [open $path(test3)]
    set x [gets $f y]
    close $f
    list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test io-33.6 {Tcl_Gets and end of file} {
7137
7138
7139
7140
7141
7142
7143
7144





7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167

    fcopy $in $out
    close $in
    close $out

    file size $path(utf8-fcopy.txt)
} 5
test io-52.11 {TclCopyChannel & encodings} {fcopy} {





    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # -translation binary is also -encoding binary
    fconfigure $in  -translation binary
    fconfigure $out -encoding koi8-r -translation lf

    fcopy $in $out
    close $in
    close $out

    file size $path(kyrillic.txt)
} 3

test io-52.12 {coverage of -translation auto} {
    file delete $path(test1) $path(test2)
    set out [open $path(test1) wb]
    chan configure $out -translation lf
    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
    close $out







|
>
>
>
>
>















|







7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172
7173
7174
7175
7176
7177
7178
7179
7180

    fcopy $in $out
    close $in
    close $out

    file size $path(utf8-fcopy.txt)
} 5
test io-52.11 {TclCopyChannel & encodings} -setup {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "\u0410\u0410"
    close $out
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # -translation binary is also -encoding binary
    fconfigure $in  -translation binary
    fconfigure $out -encoding koi8-r -translation lf

    fcopy $in $out
    close $in
    close $out

    file size $path(kyrillic.txt)
} -result 3

test io-52.12 {coverage of -translation auto} {
    file delete $path(test1) $path(test2)
    set out [open $path(test1) wb]
    chan configure $out -translation lf
    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
    close $out
8622
8623
8624
8625
8626
8627
8628


















8629
8630
8631
8632
8633
8634
8635
8636
8637
8638
8639
    lappend result [eof $rfd]
} -cleanup {
    close $wfd
    close $rfd
    removeFile io-73.5
} -result [list 1 1 more\u00a0data 1]



















# ### ### ### ######### ######### #########

# cleanup
foreach file [list fooBar longfile script script2 output test1 pipe my_script \
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io
return







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
8653
8654
8655
8656
8657
8658
8659
8660
8661
8662
8663
8664
8665
8666
8667
8668
8669
8670
    lappend result [eof $rfd]
} -cleanup {
    close $wfd
    close $rfd
    removeFile io-73.5
} -result [list 1 1 more\u00a0data 1]

test io-74.1 {[104f2885bb] improper cache validity check} -setup {
    set fn [makeFile {} io-74.1]
    set rfd [open $fn r]
    testobj freeallvars
    interp create slave
} -constraints testobj -body {
    teststringobj set 1 [string range $rfd 0 end]
    read [teststringobj get 1]		
    testobj duplicate 1 2
    interp transfer {} $rfd slave
    catch {read [teststringobj get 1]}
    read [teststringobj get 2]		
} -cleanup {
    interp delete slave
    testobj freeallvars
    removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}

# ### ### ### ######### ######### #########

# cleanup
foreach file [list fooBar longfile script script2 output test1 pipe my_script \
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io
return