diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2014-07-17 17:52:27 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2014-07-17 17:52:27 (GMT) |
commit | 96410478b940f8a102bb8d888524569e4c1e873c (patch) | |
tree | 640430a06c78c0409c0a86c29915fe0a0c3ce4bb | |
parent | db085cadf4603de2c124a2b2afc4b020d28d21c7 (diff) | |
parent | 88540658b1ee3783ec66a39d7ea77d8fb3e5cd3f (diff) | |
download | tcl-96410478b940f8a102bb8d888524569e4c1e873c.zip tcl-96410478b940f8a102bb8d888524569e4c1e873c.tar.gz tcl-96410478b940f8a102bb8d888524569e4c1e873c.tar.bz2 |
merge fork
-rw-r--r-- | tests/fCmd.test | 86 | ||||
-rw-r--r-- | tests/tcltest.test | 36 | ||||
-rw-r--r-- | tests/unixFCmd.test | 2 | ||||
-rw-r--r-- | tests/winFCmd.test | 46 | ||||
-rw-r--r-- | unix/tclUnixTest.c | 24 | ||||
-rw-r--r-- | unix/tclXtTest.c | 19 | ||||
-rw-r--r-- | win/tclWinTest.c | 47 |
7 files changed, 125 insertions, 135 deletions
diff --git a/tests/fCmd.test b/tests/fCmd.test index 5836e00..c479e35 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -128,7 +128,7 @@ proc checkcontent {file matchString} { } proc openup {path} { - testchmod 777 $path + testchmod 0777 $path if {[file isdirectory $path]} { catch { foreach p [glob -directory $path *] { @@ -362,10 +362,10 @@ test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup { cleanup } -constraints {unix notRoot testchmod} -returnCodes error -body { file mkdir td1/td2/td3 - testchmod 000 td1/td2 + testchmod 0 td1/td2 file mkdir td1/td2/td3/td4 } -cleanup { - testchmod 755 td1/td2 + testchmod 0755 td1/td2 cleanup } -result {can't create directory "td1/td2/td3": permission denied} test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup { @@ -505,11 +505,11 @@ test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup { cleanup } -constraints {unix notRoot testchmod} -body { file mkdir td1 - testchmod 000 td1 + testchmod 0 td1 createfile tf1 file rename tf1 td1 } -returnCodes error -cleanup { - testchmod 755 td1 + testchmod 0755 td1 } -result {error renaming "tf1" to "td1/tf1": permission denied} test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup { cleanup @@ -785,7 +785,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup { } -constraints {notRoot testchmod} -body { createfile tf1 createfile tf2 - testchmod 444 tf2 + testchmod 0444 tf2 file rename tf1 tf3 file rename tf2 tf4 list [lsort [glob tf*]] [file writable tf3] [file writable tf4] @@ -794,7 +794,7 @@ test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup { cleanup } -constraints {win win2000orXP testchmod} -body { file mkdir td1 td2 - testchmod 555 td2 + testchmod 0555 td2 file rename td1 td3 file rename td2 td4 list [lsort [glob td*]] [file writable td3] [file writable td4] @@ -805,7 +805,7 @@ test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup { cleanup } -constraints {unix notRoot testchmod notDarwin9} -body { file mkdir td1 td2 - testchmod 555 td2 + testchmod 0555 td2 file rename td1 td3 file rename td2 td4 list [lsort [glob td*]] [file writable td3] [file writable td4] @@ -817,7 +817,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} -setup { } -constraints {notRoot testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 - testchmod 444 tf2 + testchmod 0444 tf2 file rename -force tf1 tf1 file rename -force tf2 tf2 list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2] @@ -827,7 +827,7 @@ test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup { } -constraints {win win2000orXP testchmod} -body { file mkdir td1 file mkdir td2 - testchmod 555 td2 + testchmod 0555 td2 file rename -force td1 . file rename -force td2 . list [lsort [glob td*]] [file writable td1] [file writable td2] @@ -837,7 +837,7 @@ test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup { } -constraints {unix notRoot testchmod} -body { file mkdir td1 file mkdir td2 - testchmod 555 td2 + testchmod 0555 td2 file rename -force td1 . file rename -force td2 . list [lsort [glob td*]] [file writable td1] [file writable td2] @@ -855,10 +855,10 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup { createfile tfd2 createfile tfd3 createfile tfd4 - testchmod 444 tfs3 - testchmod 444 tfs4 - testchmod 444 tfd2 - testchmod 444 tfd4 + testchmod 0444 tfs3 + testchmod 0444 tfs4 + testchmod 0444 tfd2 + testchmod 0444 tfd4 set msg [list [catch {file rename tf1 tf2} msg] $msg] file rename -force tfs1 tfd1 file rename -force tfs2 tfd2 @@ -882,11 +882,11 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup { file mkdir [file join tdd3 tds3] file mkdir [file join tdd4 tds4] if {![testConstraint unix]} { - testchmod 555 tds3 - testchmod 555 tds4 + testchmod 0555 tds3 + testchmod 0555 tds4 } - testchmod 555 [file join tdd2 tds2] - testchmod 555 [file join tdd4 tds4] + testchmod 0555 [file join tdd2 tds2] + testchmod 0555 [file join tdd4 tds4] set msg [list [catch {file rename td1 td2} msg] $msg] file rename -force tds1 tdd1 file rename -force tds2 tdd2 @@ -911,7 +911,7 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup { file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] if {!([testConstraint unix] || [testConstraint winVista])} { - testchmod 555 tds2 + testchmod 0555 tds2 } set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg] set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg] @@ -929,7 +929,7 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup { createfile tf1 createfile tf2 file mkdir td1 - testchmod 444 tf2 + testchmod 0444 tf2 file rename tf1 [file join td1 tf3] file rename tf2 [file join td1 tf4] list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ @@ -942,7 +942,7 @@ test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { file mkdir td2 file mkdir td3 if {!([testConstraint unix] || [testConstraint winVista])} { - testchmod 555 td2 + testchmod 0555 td2 } file rename td1 [file join td3 td3] file rename td2 [file join td3 td4] @@ -958,13 +958,13 @@ test fCmd-9.12 {file rename: comprehensive: target exists} -setup { cleanup } -constraints {notRoot testchmod notNetworkFilesystem} -body { file mkdir [file join td1 td2] [file join td2 td1] - testchmod 555 [file join td2 td1] + testchmod 0555 [file join td2 td1] file mkdir [file join td3 td4] [file join td4 td3] file rename -force td3 td4 list [file exists td3] [file exists [file join td4 td3 td4]] \ [catch {file rename td1 td2} msg] $msg } -cleanup { - testchmod 755 [file join td2 td1] + testchmod 0755 [file join td2 td1] } -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}] # Test can hit EEXIST or EBUSY, depending on underlying filesystem test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup { @@ -1035,7 +1035,7 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} -setup { } -constraints {notRoot testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 - testchmod 444 tf2 + testchmod 0444 tf2 file copy tf1 tf3 file copy tf2 tf4 list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4] @@ -1045,14 +1045,14 @@ test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup { } -constraints {unix notRoot testchmod} -body { file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] - testchmod 555 td2 + testchmod 0555 td2 file copy td1 td3 file copy td2 td4 list [lsort [glob td*]] [glob -directory td3 t*] \ [glob -directory td4 t*] [file writable td3] [file writable td4] } -cleanup { - testchmod 755 td2 - testchmod 755 td4 + testchmod 0755 td2 + testchmod 0755 td4 } -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0] test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup { cleanup @@ -1060,14 +1060,14 @@ test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup { # On Windows with ACLs, copying a directory is defined like this file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] - testchmod 555 td2 + testchmod 0555 td2 file copy td1 td3 file copy td2 td4 list [lsort [glob td*]] [glob -directory td3 t*] \ [glob -directory td4 t*] [file writable td3] [file writable td4] } -cleanup { - testchmod 755 td2 - testchmod 755 td4 + testchmod 0755 td2 + testchmod 0755 td4 } -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1] test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup { cleanup @@ -1082,10 +1082,10 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup { createfile tfd2 createfile tfd3 createfile tfd4 - testchmod 444 tfs3 - testchmod 444 tfs4 - testchmod 444 tfd2 - testchmod 444 tfd4 + testchmod 0444 tfs3 + testchmod 0444 tfs4 + testchmod 0444 tfd2 + testchmod 0444 tfd4 set msg [list [catch {file copy tf1 tf2} msg] $msg] file copy -force tfs1 tfd1 file copy -force tfs2 tfd2 @@ -1106,10 +1106,10 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup { file mkdir [file join tdd2 tds2] file mkdir [file join tdd3 tds3] file mkdir [file join tdd4 tds4] - testchmod 555 tds3 - testchmod 555 tds4 - testchmod 555 [file join tdd2 tds2] - testchmod 555 [file join tdd4 tds4] + testchmod 0555 tds3 + testchmod 0555 tds4 + testchmod 0555 [file join tdd2 tds2] + testchmod 0555 [file join tdd4 tds4] set a1 [list [catch {file copy td1 td2} msg] $msg] set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg] set a3 [catch {file copy -force tds2 tdd2}] @@ -1124,7 +1124,7 @@ test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] file mkdir [file join tdd2 tds2 xxx] - testchmod 555 tds2 + testchmod 0555 tds2 set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg] set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg] list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2] @@ -1135,7 +1135,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup { createfile tf1 createfile tf2 file mkdir td1 - testchmod 444 tf2 + testchmod 0444 tf2 file copy tf1 [file join td1 tf3] file copy tf2 [file join td1 tf4] list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \ @@ -1147,7 +1147,7 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup { file mkdir td1 file mkdir td2 file mkdir td3 - testchmod 555 td2 + testchmod 0555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ @@ -1160,7 +1160,7 @@ test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup { file mkdir td1 file mkdir td2 file mkdir td3 - testchmod 555 td2 + testchmod 0555 td2 file copy td1 [file join td3 td3] file copy td2 [file join td3 td4] list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \ diff --git a/tests/tcltest.test b/tests/tcltest.test index ce8d617..5894308 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -142,7 +142,7 @@ test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrPc} { } {0 1 1 1 1} test tcltest-2.6 {tcltest -verbose 't'} { - -constraints {unixOrPc} + -constraints {unixOrPc} -body { set result [slave msg test.tcl -verbose 't'] list $result $msg @@ -152,7 +152,7 @@ test tcltest-2.6 {tcltest -verbose 't'} { } test tcltest-2.6a {tcltest -verbose 'start'} { - -constraints {unixOrPc} + -constraints {unixOrPc} -body { set result [slave msg test.tcl -verbose start] list $result $msg @@ -169,7 +169,7 @@ test tcltest-2.7 {tcltest::verbose} { verbose foo set newVerbosity [verbose] verbose $oldVerbosity - list $currentVerbosity $newVerbosity + list $currentVerbosity $newVerbosity } -result {body {}} } @@ -217,7 +217,7 @@ test tcltest-3.5 {tcltest::match} { } -result {foo bar} } - + # -skip, [skip] test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} { set result [slave msg test.tcl -skip a* -verbose 'ps'] @@ -299,8 +299,8 @@ test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)} { # -result {{} tcltestFakeConstraint1 {tcltestFakeConstraint1 tcltestFakeConstraint2}} # -cleanup { # set ::tcltest::constraintsSpecified $constraintlist -# unset ::tcltest::testConstraints(tcltestFakeConstraint1) -# unset ::tcltest::testConstraints(tcltestFakeConstraint2) +# unset ::tcltest::testConstraints(tcltestFakeConstraint1) +# unset ::tcltest::testConstraints(tcltestFakeConstraint2) # } #} @@ -348,7 +348,7 @@ set printerror [makeFile { ::tcltest::PrintError "a really really long string containing a \ \"Path/that/is/really/long/and/contains/no/spaces\"" ::tcltest::PrintError "a really really long string containing a \ - \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" + \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\"" exit } printerror.tcl] @@ -367,7 +367,7 @@ test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc unixExecs} { set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ - $result1 $result2 [file exists a.tmp] [file delete a.tmp] + $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {0 1 0 1 1 {}} test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc unixExecs} { slave msg $printerror -errfile a.tmp @@ -413,7 +413,7 @@ test tcltest-6.6 {tcltest::errorFile (implicit errorChannel)} { set f2 [errorFile $ef] set f3 [errorChannel] set f4 [errorFile] - subst {$f0;$f1;$f2;$f3;$f4} + subst {$f0;$f1;$f2;$f3;$f4} } -result {stderr;stderr;.*efile;file[0-9a-f]+;.*efile} -match regexp @@ -449,7 +449,7 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} { set f2 [outputFile $ef] set f3 [outputChannel] set f4 [outputFile] - subst {$f0;$f1;$f2;$f3;$f4} + subst {$f0;$f1;$f2;$f3;$f4} } -result {stdout;stdout;.*efile;file[0-9a-f]+;.*efile} -match regexp @@ -550,7 +550,7 @@ switch -- $::tcl_platform(platform) { } default { catch {file attributes $notWriteableDir -readonly 1} - catch {testchmod 000 $notWriteableDir} + catch {testchmod 0 $notWriteableDir} } } test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} { @@ -717,7 +717,7 @@ switch -- $::tcl_platform(platform) { file attributes $notWriteableDir -permissions 777 } default { - catch {testchmod 777 $notWriteableDir} + catch {testchmod 0777 $notWriteableDir} catch {file attributes $notWriteableDir -readonly 0} } } @@ -758,7 +758,7 @@ test tcltest-9.3 {matchFiles} { set new [matchFiles] matchFiles $old list $current $new - } + } -result {foo bar} } @@ -771,7 +771,7 @@ test tcltest-9.4 {skipFiles} { set new [skipFiles] skipFiles $old list $current $new - } + } -result {foo bar} } @@ -1146,7 +1146,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup { interp delete slave2 interp delete slave1 if {$oldoptions eq "none"} { - unset ::env(TCLTEST_OPTIONS) + unset ::env(TCLTEST_OPTIONS) } else { set ::env(TCLTEST_OPTIONS) $oldoptions } @@ -1260,7 +1260,7 @@ test tcltest-21.6 {test command - setup occurs before cleanup & before script} { } set foo 1 set expected 2 - } + } -body { incr foo set foo @@ -1424,7 +1424,7 @@ test tcltest-23.1 {makeFile} { } -cleanup { file delete -force $mfdir \ - [file join [temporaryDirectory] t1.tmp] + [file join [temporaryDirectory] t1.tmp] } -result {1 1} } @@ -1447,7 +1447,7 @@ test tcltest-23.2 {removeFile} { } -cleanup { file delete -force $mfdir \ - [file join [temporaryDirectory] t1.tmp] + [file join [temporaryDirectory] t1.tmp] } -result {0 0} } diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index e4613ed..3755fed 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -59,7 +59,7 @@ if {[testConstraint unix]} { } proc openup {path} { - testchmod 777 $path + testchmod 0777 $path if {[file isdirectory $path]} { catch { foreach p [glob -directory $path *] { diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 28257c6..14d3d07 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -335,12 +335,12 @@ test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup { test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \ -constraints {win exdev testfile testchmod} -body { file mkdir d:/td1 - testchmod 000 d:/td1 + testchmod 0 d:/td1 file mkdir c:/tf1 catch {testfile mv c:/tf1 d:/td1} msg list $msg [file writable d:/td1] } -cleanup { - catch {testchmod 666 d:/td1} + catch {testchmod 0666 d:/td1} file delete d:/td1 file delete -force c:/tf1 } -result {EXDEV 0} @@ -489,11 +489,11 @@ test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 tf1 - testchmod 000 tf1 + testchmod 0 tf1 testfile cp tf1 tf2 list [contents tf2] [file writable tf2] } -cleanup { - catch {testchmod 666 tf1} + catch {testchmod 0666 tf1} cleanup } -result {tf1 0} test winFCmd-2.13 {TclpCopyFile: CopyFile fails} -setup { @@ -535,11 +535,11 @@ test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup { } -constraints {win testfile testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 - testchmod 000 tf2 + testchmod 0 tf2 testfile cp tf1 tf2 list [file writable tf2] [contents tf2] } -cleanup { - catch {testchmod 666 tf2} + catch {testchmod 0666 tf2} cleanup } -result {1 tf1} @@ -605,7 +605,7 @@ test winFCmd-3.10 {TclpDeleteFile: path is readonly} -setup { cleanup } -constraints {win testfile testchmod} -body { createfile tf1 - testchmod 000 tf1 + testchmod 0 tf1 testfile rm tf1 file exists tf1 } -result {0} @@ -613,11 +613,11 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup { cleanup } -constraints {win testfile testchmod} -body { set fd [open tf1 w] - testchmod 000 tf1 + testchmod 0 tf1 testfile rm tf1 } -cleanup { close $fd - catch {testchmod 666 tf1} + catch {testchmod 0666 tf1} cleanup } -returnCodes error -result EACCES @@ -658,11 +658,11 @@ test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup } -constraints {winVista testfile testchmod} -body { file mkdir td1 - testchmod 000 td1 + testchmod 0 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { - catch {testchmod 666 td1} + catch {testchmod 0666 td1} cleanup } -result {td1 EACCES} # This next test has a very hokey way of matching... @@ -712,11 +712,11 @@ test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup { cleanup } -constraints {winVista testfile testchmod} -body { file mkdir td1 - testchmod 000 td1 + testchmod 0 td1 testfile rmdir td1 file exists td1 } -returnCodes error -cleanup { - catch {testchmod 666 td1} + catch {testchmod 0666 td1} cleanup } -result {td1 EACCES} test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup { @@ -730,11 +730,11 @@ test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup { cleanup } -constraints {winVista testfile testchmod} -body { file mkdir td1 - testchmod 000 td1 + testchmod 0 td1 testfile rmdir td1 file exists td1 } -cleanup { - catch {testchmod 666 td1} + catch {testchmod 0666 td1} cleanup } -returnCodes error -result {td1 EACCES} # This next test has a very hokey way of matching... @@ -830,11 +830,11 @@ test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup { } -constraints {win testfile testchmod} -body { file mkdir td1 createfile td1/tf1 tf1 - testchmod 000 td1 + testchmod 0 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } -cleanup { - catch {testchmod 666 td1} + catch {testchmod 0666 td1} cleanup } -result {1 1} test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} -setup { @@ -901,11 +901,11 @@ test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} -setup { } -constraints {win testfile testchmod} -body { file mkdir td1 createfile td1/tf1 tf1 - testchmod 000 td1 + testchmod 0 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } -cleanup { - catch {testchmod 666 td1} + catch {testchmod 0666 td1} cleanup } -result {1 1} test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} -setup { @@ -932,11 +932,11 @@ test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} -setup { cleanup } -constraints {win testfile testchmod} -body { file mkdir td1/td2 - testchmod 000 td1 + testchmod 0 td1 testfile cpdir td1 td2 list [file writable td1] [file writable td1/td2] } -cleanup { - catch {testchmod 666 td1} + catch {testchmod 0666 td1} cleanup } -result {0 1} test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} -setup { @@ -959,11 +959,11 @@ test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup } -constraints {winVista testfile testchmod} -body { file mkdir td1/td2 - testchmod 000 td1 + testchmod 0 td1 testfile rmdir -force td1 file exists td1 } -cleanup { - catch {testchmod 666 td1} + catch {testchmod 0666 td1} cleanup } -returnCodes error -result {td1 EACCES} test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} -setup { diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 4b0f369..c5ac52a 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -63,7 +63,7 @@ static const char *gotsig = "0"; */ static Tcl_CmdProc TestalarmCmd; -static Tcl_CmdProc TestchmodCmd; +static Tcl_ObjCmdProc TestchmodCmd; static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; @@ -96,7 +96,7 @@ int TclplatformtestInit( Tcl_Interp *interp) /* Interpreter to add commands to. */ { - Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, + Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, NULL, NULL); @@ -740,29 +740,25 @@ static int TestchmodCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { int i, mode; - char *rest; - if (argc < 2) { - usage: - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " mode file ?file ...?", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); return TCL_ERROR; } - mode = (int) strtol(argv[1], &rest, 8); - if ((rest == argv[1]) || (*rest != '\0')) { - goto usage; + if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) { + return TCL_ERROR; } - for (i = 2; i < argc; i++) { + for (i = 2; i < objc; i++) { Tcl_DString buffer; const char *translated; - translated = Tcl_TranslateFileName(interp, argv[i], &buffer); + translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer); if (translated == NULL) { return TCL_ERROR; } diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index fcb0773..f7c2652 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -15,7 +15,7 @@ #include <X11/Intrinsic.h> #include "tcl.h" -static Tcl_CmdProc TesteventloopCmd; +static Tcl_ObjCmdProc TesteventloopCmd; extern DLLEXPORT Tcl_PackageInitProc Tclxttest_Init; /* @@ -53,7 +53,7 @@ Tclxttest_Init( } XtToolkitInitialize(); InitNotifier(); - Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, + Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); return TCL_OK; } @@ -80,21 +80,20 @@ static int TesteventloopCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { static int *framePtr = NULL;/* Pointer to integer on stack frame of * innermost invocation of the "wait" * subcommand. */ - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ..."); return TCL_ERROR; } - if (strcmp(argv[1], "done") == 0) { + if (strcmp(Tcl_GetString(objv[1]), "done") == 0) { *framePtr = 1; - } else if (strcmp(argv[1], "wait") == 0) { + } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { int *oldFramePtr; int done; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); @@ -118,7 +117,7 @@ TesteventloopCmd( (void) Tcl_SetServiceMode(oldMode); framePtr = oldFramePtr; } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be done or wait", NULL); return TCL_ERROR; } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 6027e32..b3ad626 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -32,8 +32,8 @@ * Forward declarations of functions defined later in this file: */ -static int TesteventloopCmd(ClientData dummy, Tcl_Interp *interp, - int argc, const char **argv); +static int TesteventloopCmd(ClientData dummy, Tcl_Interp* interp, + int objc, Tcl_Obj *const objv[]); static int TestvolumetypeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -43,8 +43,8 @@ static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]); static Tcl_ObjCmdProc TestExceptionCmd; static int TestplatformChmod(const char *nativePath, int pmode); -static int TestchmodCmd(ClientData dummy, - Tcl_Interp *interp, int argc, const char **argv); +static int TestchmodCmd(ClientData dummy, Tcl_Interp* interp, + int objc, Tcl_Obj *const objv[]); /* *---------------------------------------------------------------------- @@ -71,8 +71,8 @@ TclplatformtestInit( * Add commands for platform specific tests for Windows here. */ - Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL); @@ -103,21 +103,20 @@ static int TesteventloopCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { static int *framePtr = NULL;/* Pointer to integer on stack frame of * innermost invocation of the "wait" * subcommand. */ - if (argc < 2) { - Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ..."); return TCL_ERROR; } - if (strcmp(argv[1], "done") == 0) { + if (strcmp(Tcl_GetString(objv[1]), "done") == 0) { *framePtr = 1; - } else if (strcmp(argv[1], "wait") == 0) { + } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { int *oldFramePtr, done; int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); @@ -152,7 +151,7 @@ TesteventloopCmd( (void) Tcl_SetServiceMode(oldMode); framePtr = oldFramePtr; } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], + Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be done or wait", NULL); return TCL_ERROR; } @@ -623,29 +622,25 @@ static int TestchmodCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Parameter count */ + Tcl_Obj *const * objv) /* Parameter vector */ { int i, mode; - char *rest; - if (argc < 2) { - usage: - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " mode file ?file ...?", NULL); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); return TCL_ERROR; } - mode = (int) strtol(argv[1], &rest, 8); - if ((rest == argv[1]) || (*rest != '\0')) { - goto usage; + if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) { + return TCL_ERROR; } - for (i = 2; i < argc; i++) { + for (i = 2; i < objc; i++) { Tcl_DString buffer; const char *translated; - translated = Tcl_TranslateFileName(interp, argv[i], &buffer); + translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer); if (translated == NULL) { return TCL_ERROR; } |