diff options
| -rw-r--r-- | tests/cmdAH.test | 49 | ||||
| -rw-r--r-- | tests/incr.test | 8 | ||||
| -rw-r--r-- | tests/scan.test | 45 | ||||
| -rw-r--r-- | tests/set.test | 20 |
4 files changed, 93 insertions, 29 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test index f463683..58bb728 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.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: cmdAH.test,v 1.8 1999/08/19 03:00:12 hobbs Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.9 1999/10/29 03:04:37 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -168,8 +168,8 @@ test cmdAH-5.2 {Tcl_FileObjCmd} { list [catch {file x} msg] $msg } {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}} test cmdAH-5.3 {Tcl_FileObjCmd} { - list [catch {file atime} msg] $msg -} {1 {wrong # args: should be "file atime name"}} + list [catch {file exists} msg] $msg +} {1 {wrong # args: should be "file exists name"}} #volume @@ -1156,9 +1156,11 @@ catch {exec chmod 765 gorp.file} # atime +set file [makeFile "data" touch.me] + test cmdAH-20.1 {Tcl_FileObjCmd: atime} { - list [catch {file atime a b} msg] $msg -} {1 {wrong # args: should be "file atime name"}} + list [catch {file atime a b c} msg] $msg +} {1 {wrong # args: should be "file atime name ?time?"}} test cmdAH-20.2 {Tcl_FileObjCmd: atime} { catch {unset stat} file stat gorp.file stat @@ -1169,6 +1171,26 @@ test cmdAH-20.3 {Tcl_FileObjCmd: atime} { string tolower [list [catch {file atime _bogus_} msg] \ $msg $errorCode] } {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}} +test cmdAH-20.4 {Tcl_FileObjCmd: atime} { + list [catch {file atime $file notint} msg] $msg +} {1 {expected integer but got "notint"}} +test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} { + if {[string equal $tcl_platform(platform) "windows"]} { + set old [pwd] + cd $::tcltest::temporaryDirectory + if {![string equal "NTFS" [testvolumetype]]} { + # Windows FAT doesn't understand atime, but NTFS does + # May also fail for Windows on NFS mounted disks + cd $old + return 1 + } + cd $old + } + set atime [file atime $file] + after 1100; # pause a sec to notice change in atime + set newatime [clock seconds] + expr {$newatime==[file atime $file $newatime]} +} 1 # isdirectory @@ -1223,9 +1245,11 @@ catch {unset stat} # mtime +set file [makeFile "data" touch.me] + test cmdAH-24.1 {Tcl_FileObjCmd: mtime} { - list [catch {file mtime a b} msg] $msg -} {1 {wrong # args: should be "file mtime name"}} + list [catch {file mtime a b c} msg] $msg +} {1 {wrong # args: should be "file mtime name ?time?"}} test cmdAH-24.2 {Tcl_FileObjCmd: mtime} { set old [file mtime gorp.file] after 2000 @@ -1249,7 +1273,7 @@ test cmdAH-24.5 {Tcl_FileObjCmd: mtime} { # Under Unix, use a file in /tmp to avoid clock skew due to NFS. # On other platforms, just use a file in the local directory. - if {$tcl_platform(platform) == "unix"} { + if {[string equal $tcl_platform(platform) "unix"]} { set name /tmp/tcl.test } else { set name tf @@ -1264,6 +1288,15 @@ test cmdAH-24.5 {Tcl_FileObjCmd: mtime} { file delete $name set a } {1} +test cmdAH-24.7 {Tcl_FileObjCmd: mtime} { + list [catch {file mtime $file notint} msg] $msg +} {1 {expected integer but got "notint"}} +test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} { + set mtime [file mtime $file] + after 1100; # pause a sec to notice change in mtime + set newmtime [clock seconds] + expr {$newmtime==[file mtime $file $newmtime]} +} 1 # owned diff --git a/tests/incr.test b/tests/incr.test index 533b002..046e9ad 100644 --- a/tests/incr.test +++ b/tests/incr.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: incr.test,v 1.4 1999/06/26 03:54:14 jenn Exp $ +# RCS: @(#) $Id: incr.test,v 1.5 1999/10/29 03:04:37 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -239,6 +239,12 @@ test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} { set x " - " list [catch {incr x 1} msg] $msg } {1 {expected integer but got " - "}} + +test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} { + catch {unset array} + set array(\$foo) 4 + incr {array($foo)} +} 5 # Check "incr" and computed command names. diff --git a/tests/scan.test b/tests/scan.test index 842e0f7..1b2b3fa 100644 --- a/tests/scan.test +++ b/tests/scan.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: scan.test,v 1.6 1999/06/26 20:55:12 rjohnson Exp $ +# RCS: @(#) $Id: scan.test,v 1.7 1999/10/29 03:04:37 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -60,8 +60,9 @@ test scan-3.3 {ValidateFormat} { list [catch {scan {} {%2$d%d} x} msg] $msg } {1 {"%n$" argument index out of range}} test scan-3.4 {ValidateFormat} { + # degenerate case, before changed from 8.2 to 8.3 list [catch {scan {} %d} msg] $msg -} {1 {different numbers of variable names and field specifiers}} +} {0 {}} test scan-3.5 {ValidateFormat} { list [catch {scan {} {%10c} a} msg] $msg } {1 {field width may not be specified in %c conversion}} @@ -73,10 +74,10 @@ test scan-3.7 {ValidateFormat} { } {1 {variable is assigned by multiple "%n$" conversion specifiers}} test scan-3.8 {ValidateFormat} { list [catch {scan {} a x} msg] $msg -} {1 {variable is not assigend by any conversion specifiers}} +} {1 {variable is not assigned by any conversion specifiers}} test scan-3.9 {ValidateFormat} { list [catch {scan {} {%2$s} x y} msg] $msg -} {1 {variable is not assigend by any conversion specifiers}} +} {1 {variable is not assigned by any conversion specifiers}} test scan-3.10 {ValidateFormat} { list [catch {scan {} {%[a} x} msg] $msg } {1 {unmatched [ in format string}} @@ -97,8 +98,9 @@ test scan-4.2 {Tcl_ScanObjCmd, argument checks} { list [catch {scan string} msg] $msg } {1 {wrong # args: should be "scan string format ?varName varName ...?"}} test scan-4.3 {Tcl_ScanObjCmd, argument checks} { + # degenerate case, before changed from 8.2 to 8.3 list [catch {scan string format} msg] $msg -} {0 0} +} {0 {}} test scan-4.4 {Tcl_ScanObjCmd, whitespace} { list [scan { abc def } {%s%s} x y] $x $y } {2 abc def} @@ -109,8 +111,9 @@ test scan-4.6 {Tcl_ScanObjCmd, whitespace} { list [scan { abc def } { %s %s } x y] $x $y } {2 abc def} test scan-4.7 {Tcl_ScanObjCmd, literals} { + # degenerate case, before changed from 8.2 to 8.3 scan { abc def } { abc def } -} 0 +} {} test scan-4.8 {Tcl_ScanObjCmd, literals} { set x {} list [scan { abcg} { abc def %1s} x] $x @@ -466,7 +469,7 @@ test scan-8.8 {error conditions} { } {1 {different numbers of variable names and field specifiers}} test scan-8.9 {error conditions} { list [catch {scan a "%d %d" a b c} msg] $msg -} {1 {variable is not assigend by any conversion specifiers}} +} {1 {variable is not assigned by any conversion specifiers}} test scan-8.10 {error conditions} { set a {}; set b {}; set c {}; set d {} list [expr {[scan " a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d @@ -568,6 +571,34 @@ test scan-11.5 {alignment in results array (TCL_ALIGN)} { set b } 13.6 +test scan-12.1 {Tcl_ScanObjCmd, inline case} { + scan a %c +} 97 +test scan-12.2 {Tcl_ScanObjCmd, inline case} { + scan abc %c%c%c%c +} {97 98 99 {}} +test scan-12.3 {Tcl_ScanObjCmd, inline case} { + scan abc %s%c +} {abc {}} +test scan-12.4 {Tcl_ScanObjCmd, inline case} { + scan abc abc%c +} {} +test scan-12.5 {Tcl_ScanObjCmd, inline case} { + scan abc bogus%c%c%c +} {{} {} {}} +test scan-12.6 {Tcl_ScanObjCmd, inline case} { + list [catch {scan abc {%1$s}} msg] $msg +} {1 {"%n$" argument index out of range}} +test scan-12.7 {Tcl_ScanObjCmd, inline case} { + # degenerate case, behavior changed from 8.2 to 8.3 + list [catch {scan foo foobar} msg] $msg +} {0 {}} +test scan-9.2 {Tcl_ScanObjCmd, inline case lots of arguments} { + scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140\ + 150 160 170 180 190 200" \ + "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" +} {10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200 {}} + # cleanup ::tcltest::cleanupTests return diff --git a/tests/set.test b/tests/set.test index 736e0e5..522b2a9 100644 --- a/tests/set.test +++ b/tests/set.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: set.test,v 1.5 1999/06/26 20:55:12 rjohnson Exp $ +# RCS: @(#) $Id: set.test,v 1.6 1999/10/29 03:04:37 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -200,6 +200,12 @@ test set-1.24 {TclCompileSetCmd: too many arguments} { set msg } {wrong # args: should be "set varName ?newValue?"} +test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} { + # This was a known error in 8.1a* - 8.2.1 + catch {unset array} + set {array($foo)} 5 +} 5 + test set-2.1 {set command: runtime error, bad variable name} { list [catch {set {"foo}} msg] $msg $errorInfo } {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable @@ -486,15 +492,3 @@ catch {unset x} catch {unset z} ::tcltest::cleanupTests return - - - - - - - - - - - - |