ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tcl 8.6.11

Browse Source
This commit is contained in:
Steve Dower
2021-03-30 00:51:39 +01:00
parent 3bb8e3e086
commit 1aadb2455c
923 changed files with 79104 additions and 62616 deletions
Download Patch File Download Diff File Expand all files Collapse all files

83
tests/fCmd.test
View File

@@ -11,7 +11,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2
package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -24,6 +24,7 @@ testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint win2000orXP 0
testConstraint winLessThan10 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
testConstraint reg 0
@@ -64,13 +65,16 @@ if {[testConstraint unix]} {
}
# Also used in winFCmd...
if {[testConstraint win]} {
if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
if {$::tcl_platform(osVersion) >= 6.0} {
testConstraint winVista 1
} else {
testConstraint win2000orXP 1
}
if {[testConstraint win] && [testConstraint nt]} {
if {$::tcl_platform(osVersion) >= 5.0} {
if {$::tcl_platform(osVersion) < 10.0} {
testConstraint winLessThan10 1
}
if {$::tcl_platform(osVersion) >= 6.0} {
testConstraint winVista 1
} else {
testConstraint win2000orXP 1
}
}
}
@@ -80,6 +84,7 @@ testConstraint darwin9 [expr {
&& [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
testConstraint notContinuousIntegration [expr {![info exists ::env(CI)]}]
testConstraint fileSharing 0
testConstraint notFileSharing 1
@@ -623,10 +628,10 @@ test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
cleanup $tmpspace
} -constraints {xdev notRoot} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0000
file attributes td1 -permissions 0o000
file rename td1 $tmpspace
} -returnCodes error -cleanup {
file attributes td1 -permissions 0755
file attributes td1 -permissions 0o755
cleanup
} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}
test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
@@ -634,10 +639,10 @@ test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
} -constraints {unix notRoot} -body {
file mkdir ~/td1/td2
set td1name [file join [file dirname ~] [file tail ~] td1]
file attributes $td1name -permissions 0000
file attributes $td1name -permissions 0o000
file copy ~/td1 td1
} -returnCodes error -cleanup {
file attributes $td1name -permissions 0755
file attributes $td1name -permissions 0o755
file delete -force ~/td1
} -result {error copying "~/td1": permission denied}
test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup {
@@ -646,10 +651,10 @@ test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup {
file mkdir td2
file mkdir ~/td1
set td1name [file join [file dirname ~] [file tail ~] td1]
file attributes $td1name -permissions 0000
file attributes $td1name -permissions 0o000
file copy td2 ~/td1
} -returnCodes error -cleanup {
file attributes $td1name -permissions 0755
file attributes $td1name -permissions 0o755
file delete -force ~/td1
} -result {error copying "td2" to "~/td1/td2": permission denied}
test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
@@ -657,10 +662,10 @@ test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
} -constraints {unix notRoot} -body {
file mkdir ~/td1/td2
set td2name [file join [file dirname ~] [file tail ~] td1 td2]
file attributes $td2name -permissions 0000
file attributes $td2name -permissions 0o000
file copy ~/td1 td1
} -returnCodes error -cleanup {
file attributes $td2name -permissions 0755
file attributes $td2name -permissions 0o755
file delete -force ~/td1
} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied"
test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
@@ -675,10 +680,10 @@ test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
cleanup $tmpspace
} -constraints {notRoot xdev} -body {
file mkdir td1/td2/td3
file attributes td1/td2/td3 -permissions 0000
file attributes td1/td2/td3 -permissions 0o000
file rename td1 $tmpspace
} -returnCodes error -cleanup {
file attributes td1/td2/td3 -permissions 0755
file attributes td1/td2/td3 -permissions 0o755
cleanup $tmpspace
} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied}
test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
@@ -1342,10 +1347,10 @@ test fCmd-12.8 {renamefile: generic error} -setup {
} -constraints {unix notRoot} -body {
file mkdir tfa
file mkdir tfa/dir
file attributes tfa -permissions 0555
file attributes tfa -permissions 0o555
catch {file rename tfa/dir tfa2}
} -cleanup {
catch {file attributes tfa -permissions 0777}
catch {file attributes tfa -permissions 0o777}
file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
@@ -1528,10 +1533,10 @@ test fCmd-14.8 {copyfile: copy directory failing} -setup {
catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
file mkdir tfa/dir/a/b/c
file attributes tfa/dir -permissions 0000
file attributes tfa/dir -permissions 0o000
catch {file copy tfa tfa2}
} -cleanup {
file attributes tfa/dir -permissions 0777
file attributes tfa/dir -permissions 0o777
file delete -force tfa tfa2
} -result {1}
@@ -1571,10 +1576,10 @@ test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
} -constraints {unix notRoot} -body {
file mkdir tfa
createfile tfa/file
file attributes tfa -permissions 0000
file attributes tfa -permissions 0o000
catch {file mkdir tfa/file}
} -cleanup {
file attributes tfa -permissions 0777
file attributes tfa -permissions 0o777
file delete -force tfa
} -result {1}
test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
@@ -1671,7 +1676,7 @@ test fCmd-16.9 {error while deleting file} -setup {
} -constraints {unix notRoot} -body {
file mkdir tfa
createfile tfa/a
file attributes tfa -permissions 0555
file attributes tfa -permissions 0o555
catch {file delete tfa/a}
#######
####### If any directory in a tree that is being removed does not have
@@ -1679,7 +1684,7 @@ test fCmd-16.9 {error while deleting file} -setup {
####### with "rm -rf"
#######
} -cleanup {
file attributes tfa -permissions 0777
file attributes tfa -permissions 0o777
file delete -force tfa
} -result {1}
test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
@@ -1701,10 +1706,10 @@ test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup {
catch {file delete -force -- tfa1}
} -constraints {unix notRoot} -body {
file mkdir tfa1
file attributes tfa1 -permissions 0555
file attributes tfa1 -permissions 0o555
catch {file mkdir tfa1/tfa2}
} -cleanup {
file attributes tfa1 -permissions 0777
file attributes tfa1 -permissions 0o777
file delete -force tfa1
} -result {1}
test fCmd-17.2 {mkdir several levels deep - relative} -setup {
@@ -1912,10 +1917,10 @@ test fCmd-19.2 {rmdir error besides EEXIST} -setup {
} -constraints {unix notRoot} -body {
file mkdir tfa
file mkdir tfa/a
file attributes tfa -permissions 0555
file attributes tfa -permissions 0o555
catch {file delete tfa/a}
} -cleanup {
file attributes tfa -permissions 0777
file attributes tfa -permissions 0o777
file delete -force tfa
} -result {1}
test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
@@ -1940,10 +1945,10 @@ test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -se
} -constraints {unix notRoot} -body {
file mkdir tfa
file mkdir tfa/a
file attributes tfa/a -permissions 0000
file attributes tfa/a -permissions 0o000
catch {file delete -force tfa}
} -cleanup {
file attributes tfa/a -permissions 0777
file attributes tfa/a -permissions 0o777
file delete -force tfa
} -result {1}
test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
@@ -2354,13 +2359,15 @@ test fCmd-28.7 {file link: source already exists} -setup {
} -returnCodes error -cleanup {
cd [workingDirectory]
} -result {could not create new link "abc.file": that path already exists}
test fCmd-28.8 {file link} -constraints {linkFile win} -setup {
# In Windows 10 developer mode, we _can_ create symbolic links to files!
test fCmd-28.8 {file link} -constraints {linkFile winLessThan10} -setup {
cd [temporaryDirectory]
} -body {
file link -symbolic abc.link abc.file
} -returnCodes error -cleanup {
} -cleanup {
file delete -force abc.link
cd [workingDirectory]
} -result {could not create new link "abc.link" pointing to "abc.file": not a directory}
} -returnCodes error -result {could not create new link "abc.link" pointing to "abc.file": invalid argument}
test fCmd-28.9 {file link: success with file} -constraints {linkFile} -setup {
cd [temporaryDirectory]
file delete -force abc.link
@@ -2582,7 +2589,11 @@ test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body {
&& [file exists $env(USERPROFILE)/NTUSER.DAT]
&& [file readable $env(USERPROFILE)/NTUSER.DAT]}
} -result {1}
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win} -body {
# At least one CI environment (GitHub Actions) is set up with the page file in
# an unusual location; skip the test if that is so.
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {
win notContinuousIntegration
} -body {
set r {}
if {[info exists env(SystemDrive)]} {
set path $env(SystemDrive)/pagefile.sys