diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/expr.test | 5 | ||||
| -rw-r--r-- | tests/info.test | 60 | ||||
| -rw-r--r-- | tests/namespace.test | 6 | ||||
| -rw-r--r-- | tests/unixFCmd.test | 31 | ||||
| -rw-r--r-- | tests/utf.test | 6 |
5 files changed, 99 insertions, 9 deletions
diff --git a/tests/expr.test b/tests/expr.test index 042002a..58fd168 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr.test,v 1.7 1999/12/04 06:16:48 hobbs Exp $ +# RCS: @(#) $Id: expr.test,v 1.8 2000/01/12 11:13:25 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -647,6 +647,9 @@ test expr-18.1 {expr and conversion of operands to numbers} { catch {expr int($x)} expr {$x} } 11 +test expr-18.2 {whitespace strings should not be == 0 (buggy strtod)} { + expr {" "} +} { } # Check "expr" and interpreter result object resetting before appending # an error msg during evaluation of exprs not in {}s diff --git a/tests/info.test b/tests/info.test index 9297931..a9ba98b 100644 --- a/tests/info.test +++ b/tests/info.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.12 1999/12/12 02:27:03 hobbs Exp $ +# RCS: @(#) $Id: info.test,v 1.13 2000/01/12 11:13:25 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -426,6 +426,64 @@ test info-15.4 {info procs option} { list [info procs] [info procs p*] } } {{p q r} p} +test info-15.5 {info procs option with a proc in a namespace} { + catch {namespace delete test_ns_info2} + namespace eval test_ns_info2 { + proc p1 { arg } { + puts cmd + } + proc p2 { arg } { + puts cmd + } + } + info procs ::test_ns_info2::p1 +} {::test_ns_info2::p1} +test info-15.6 {info procs option with a pattern in a namespace} { + catch {namespace delete test_ns_info2} + namespace eval test_ns_info2 { + proc p1 { arg } { + puts cmd + } + proc p2 { arg } { + puts cmd + } + } + lsort [info procs ::test_ns_info2::p*] +} [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]] +test info-15.7 {info procs option with a global shadowing proc} { + catch {namespace delete test_ns_info2} + proc string_cmd { arg } { + puts cmd + } + namespace eval test_ns_info2 { + proc string_cmd { arg } { + puts cmd + } + } + info procs test_ns_info2::string* +} {::test_ns_info2::string_cmd} +# This regression test is currently commented out because it requires +# that the implementation of "info procs" looks into the global namespace, +# which it does not (in contrast to "info commands") +if {0} { +test info-15.8 {info procs option with a global shadowing proc} { + catch {namespace delete test_ns_info2} + proc string_cmd { arg } { + puts cmd + } + proc string_cmd2 { arg } { + puts cmd + } + namespace eval test_ns_info2 { + proc string_cmd { arg } { + puts cmd + } + } + namespace eval test_ns_info2 { + lsort [info procs string*] + } +} [lsort [list string_cmd string_cmd2]] +} test info-16.1 {info script option} { list [catch {info script x} msg] $msg diff --git a/tests/namespace.test b/tests/namespace.test index c954aa2..5843187 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace.test,v 1.6 1999/06/26 20:55:08 rjohnson Exp $ +# RCS: @(#) $Id: namespace.test,v 1.7 2000/01/12 11:13:25 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -675,8 +675,8 @@ test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} { } {::test_ns_1::test_ns_foo} test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} { namespace eval test_ns_1::test_ns_foo {} - namespace children test_ns_1 test* -} {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo} + lsort [namespace children test_ns_1 test*] +} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}] test namespace-22.1 {NamespaceCodeCmd, bad args} { catch {eval namespace delete [namespace children :: test_ns_*]} diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index b06977c..79b63dd 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixFCmd.test,v 1.9 1999/07/01 17:36:20 jenn Exp $ +# RCS: @(#) $Id: unixFCmd.test,v 1.10 2000/01/12 11:13:25 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -267,7 +267,34 @@ test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} { close [open foo.test w] list [catch {file attributes foo.test -permissions foo} msg] $msg \ [file delete -force -- foo.test] -} {1 {expected integer but got "foo"} {}} +} {1 {unknown permission string format "foo"} {}} +test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} { + catch {file delete -force -- foo.test} + close [open foo.test w] + list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \ + [file delete -force -- foo.test] +} {1 {unknown permission string format "---rwx"} {}} + +close [open foo.test w] +set ::i 4 +proc permcheck {permstr expected} { + test unixFCmd-17.[incr ::i] {SetPermissionsAttribute} {unixOnly notRoot} \ + [subst { + file attributes foo.test -permissions $permstr + file attributes foo.test -permissions + } + ] $expected +} +permcheck rwxrwxrwx 00777 +permcheck r--r---w- 00442 +permcheck 0 00000 +permcheck u+rwx,g+r 00740 +permcheck u-w 00540 +permcheck o+rwx 00547 +permcheck --x--x--x 00111 +permcheck a+rwx 00777 +file delete -force -- foo.test + test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} { # This test is nonportable because SunOS generates a weird error # message when the current directory isn't readable. diff --git a/tests/utf.test b/tests/utf.test index 3250097..6c8ee89 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: utf.test,v 1.5 1999/06/26 20:55:17 rjohnson Exp $ +# RCS: @(#) $Id: utf.test,v 1.6 2000/01/12 11:13:26 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -141,7 +141,9 @@ bsCheck \\ 92 bsCheck \Ca 67 bsCheck \Ma 77 bsCheck \CMa 67 -bsCheck \8a 8 +# prior to 8.3, this returned 8, as \8 as accepted as an +# octal value - but it isn't! [Bug: 3975] +bsCheck \8a 56 bsCheck \14 12 bsCheck \141 97 bsCheck b\0 98 |