diff options
| author | Kevin B Kenny <kennykb@acm.org> | 2011-03-01 04:16:27 (GMT) |
|---|---|---|
| committer | Kevin B Kenny <kennykb@acm.org> | 2011-03-01 04:16:27 (GMT) |
| commit | b153d7d08398bacf50287f086acee27748d21799 (patch) | |
| tree | fe0d74fb715de8a7a2d9ae7bfd47e54e1114fc38 /tests | |
| parent | 7c4049a13f83930bf6a57ef889abc9e49fa414ec (diff) | |
| parent | cd34f84f42b4e64866a9177553e91417ded252a0 (diff) | |
| download | tcl-b153d7d08398bacf50287f086acee27748d21799.zip tcl-b153d7d08398bacf50287f086acee27748d21799.tar.gz tcl-b153d7d08398bacf50287f086acee27748d21799.tar.bz2 | |
merge trunk
Diffstat (limited to 'tests')
50 files changed, 4268 insertions, 2288 deletions
diff --git a/tests/append.test b/tests/append.test index c6120f2..21afbfb 100644 --- a/tests/append.test +++ b/tests/append.test @@ -11,14 +11,14 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: append.test,v 1.12.2.1 2010/12/11 18:39:29 kennykb Exp $ +# RCS: @(#) $Id: append.test,v 1.13 2010/12/09 10:47:53 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } unset -nocomplain x - + test append-1.1 {append command} { unset -nocomplain x list [append x 1 2 abc "long string"] $x @@ -294,7 +294,7 @@ test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env } -cleanup { unset -nocomplain ::env(__DUMMY__) } -result {0 {new value}} - + unset -nocomplain i x result y catch {rename foo ""} diff --git a/tests/appendComp.test b/tests/appendComp.test index 93323fb..9d1e3a5 100644 --- a/tests/appendComp.test +++ b/tests/appendComp.test @@ -11,14 +11,14 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: appendComp.test,v 1.13.2.1 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: appendComp.test,v 1.14 2010/12/09 10:47:53 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } catch {unset x} - + test appendComp-1.1 {append command} -setup { unset -nocomplain x } -body { @@ -440,7 +440,7 @@ test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing } -cleanup { unset -nocomplain ::env(__DUMMY__) } -result {0 {new value}} - + catch {unset i x result y} catch {rename foo ""} catch {rename bar ""} diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test index 56e1ffb..2b15377 100644 --- a/tests/autoMkindex.test +++ b/tests/autoMkindex.test @@ -1,17 +1,17 @@ # Commands covered: auto_mkindex auto_import # -# This file contains tests related to autoloading and generating -# the autoloading index. +# This file contains tests related to autoloading and generating the +# autoloading index. # # Copyright (c) 1998 Lucent Technologies, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: autoMkindex.test,v 1.15 2004/05/25 17:44:29 dgp Exp $ +# RCS: @(#) $Id: autoMkindex.test,v 1.16 2011/01/06 10:20:39 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } @@ -19,10 +19,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { makeFile {# Test file for: # auto_mkindex # -# This file provides example cases for testing the Tcl autoloading -# facility. Things are much more complicated with namespaces and classes. -# The "auto_mkindex" facility can no longer be built on top of a simple -# regular expression parser. It must recognize constructs like this: +# This file provides example cases for testing the Tcl autoloading facility. +# Things are much more complicated with namespaces and classes. The +# "auto_mkindex" facility can no longer be built on top of a simple regular +# expression parser. It must recognize constructs like this: # # namespace eval foo { # proc test {x y} { ... } @@ -31,23 +31,23 @@ makeFile {# Test file for: # } # } # -# Note that procedures and itcl class definitions can be nested inside -# of namespaces. +# Note that procedures and itcl class definitions can be nested inside of +# namespaces. # # Copyright (c) 1993-1998 Lucent Technologies, Inc. # This shouldn't cause any problems namespace import -force blt::* -# Should be able to handle "proc" definitions, even if they are -# preceded by white space. +# Should be able to handle "proc" definitions, even if they are preceded by +# white space. proc normal {x y} {return [expr $x+$y]} proc indented {x y} {return [expr $x+$y]} # -# Should be able to handle proc declarations within namespaces, -# even if they have explicit namespace paths. +# Should be able to handle proc declarations within namespaces, even if they +# have explicit namespace paths. # namespace eval buried { proc inside {args} {return "inside: $args"} @@ -69,8 +69,8 @@ namespace eval buried { } } -# With proper hooks, we should be able to support other commands -# that create procedures +# With proper hooks, we should be able to support other commands that create +# procedures proc buried::myproc {name body args} { ::proc $name $body $args @@ -90,17 +90,15 @@ namespace eval ::buried { } {::buried::my proc} mycmd6 args {return "another"} -# A correctly functioning [auto_import] won't choke when a child -# namespace [namespace import]s from its parent. +# A correctly functioning [auto_import] won't choke when a child namespace +# [namespace import]s from its parent. # namespace eval ::parent::child { namespace import ::parent::* } proc ::parent::child::test {} {} - } autoMkindex.tcl - # Save initial state of auto_mkindex_parser auto_load auto_mkindex @@ -120,21 +118,19 @@ set result "" set origDir [pwd] cd $::tcltest::temporaryDirectory - + test autoMkindex-1.1 {remove any existing tclIndex file} { file delete tclIndex file exists tclIndex } {0} - test autoMkindex-1.2 {build tclIndex based on a test file} { auto_mkindex . autoMkindex.tcl file exists tclIndex } {1} - set element "{source [file join . autoMkindex.tcl]}" - -test autoMkindex-1.3 {examine tclIndex} { +test autoMkindex-1.3 {examine tclIndex} -setup { file delete tclIndex +} -body { auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." @@ -145,33 +141,35 @@ test autoMkindex-1.3 {examine tclIndex} { lappend ::result [list $elem $auto_index($elem)] } } + return $result +} -cleanup { namespace delete tcl_autoMkindex_tmp - set ::result -} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}" - +} -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}" -test autoMkindex-2.1 {commands on the autoload path can be imported} { +test autoMkindex-2.1 {commands on the autoload path can be imported} -setup { file delete tclIndex + interp create slave +} -body { auto_mkindex . autoMkindex.tcl - set interp [interp create] - set final [$interp eval { + slave eval { namespace eval blt {} set auto_path [linsert $auto_path 0 .] set info [list [catch {namespace import buried::*} result] $result] foreach name [lsort [info commands pub_*]] { lappend info $name [namespace origin $name] } - set info - }] - interp delete $interp - set final -} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two" + return $info + } +} -cleanup { + interp delete slave +} -result "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two" # Test auto_mkindex hooks # Slave hook executes interesting code in the interp used to watch code. - -test autoMkindex-3.1 {slaveHook} { +test autoMkindex-3.1 {slaveHook} -setup { + file delete tclIndex +} -body { auto_mkindex_parser::slavehook { _%@namespace eval ::blt { proc foo {} {} @@ -179,26 +177,23 @@ test autoMkindex-3.1 {slaveHook} { } } auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* } - file delete tclIndex auto_mkindex . autoMkindex.tcl - + file exists tclIndex +} -cleanup { # Reset initCommands to avoid trashing other tests - AutoMkindexTestReset - file exists tclIndex -} 1 - -# The auto_mkindex_parser::command is used to register commands -# that create new commands. - -test autoMkindex-3.2 {auto_mkindex_parser::command} { +} -result 1 +# The auto_mkindex_parser::command is used to register commands that create +# new commands. +test autoMkindex-3.2 {auto_mkindex_parser::command} -setup { + file delete tclIndex +} -body { auto_mkindex_parser::command buried::myproc {name args} { variable index variable scriptFile append index [list set auto_index([fullname $name])] \ " \[list source \[file join \$dir [list $scriptFile]\]\]\n" } - file delete tclIndex auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." @@ -208,17 +203,16 @@ test autoMkindex-3.2 {auto_mkindex_parser::command} { foreach elem [lsort [array names auto_index]] { lappend ::result [list $elem $auto_index($elem)] } + return $::result } +} -cleanup { namespace delete tcl_autoMkindex_tmp - # Reset initCommands to avoid trashing other tests - AutoMkindexTestReset - set ::result -} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}" - - -test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} { +} -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}" +test autoMkindex-3.3 {auto_mkindex_parser::command} -setup { + file delete tclIndex +} -constraints {knownBug} -body { auto_mkindex_parser::command {buried::my proc} {name args} { variable index variable scriptFile @@ -226,7 +220,6 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} { append index [list set auto_index([fullname $name])] \ " \[list source \[file join \$dir [list $scriptFile]\]\]\n" } - file delete tclIndex auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." @@ -237,109 +230,93 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} { lappend ::result [list $elem $auto_index($elem)] } } + list [lsearch -inline $::result *mycmd4*] \ + [lsearch -inline $::result *mycmd5*] \ + [lsearch -inline $::result *mycmd6*] +} -cleanup { namespace delete tcl_autoMkindex_tmp - # Reset initCommands to avoid trashing other tests - AutoMkindexTestReset - proc lvalue {list pattern} { - set ix [lsearch $list $pattern] - if {$ix >= 0} { - return [lindex $list $ix] - } else { - return {} - } - } - list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*] -} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}" - - -makeDirectory pkg -makeFile { -package provide football 1.0 - -namespace eval ::pro:: { - # - # export only public functions. - # - namespace export {[a-z]*} -} -namespace eval ::college:: { - # - # export only public functions. - # - namespace export {[a-z]*} -} - -proc ::pro::team {} { - puts "go packers!" - return true -} +} -result "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}" -proc ::college::team {} { - puts "go badgers!" - return true -} - -} [file join pkg samename.tcl] - - -test autoMkindex-4.1 {platform indenpendant source commands} { +test autoMkindex-4.1 {platform independent source commands} -setup { file delete tclIndex + makeDirectory pkg + makeFile { + package provide football 1.0 + namespace eval ::pro:: { + # + # export only public functions. + # + namespace export {[a-z]*} + } + namespace eval ::college:: { + # + # export only public functions. + # + namespace export {[a-z]*} + } + proc ::pro::team {} { + puts "go packers!" + return true + } + proc ::college::team {} { + puts "go badgers!" + return true + } + } [file join pkg samename.tcl] +} -body { auto_mkindex . pkg/samename.tcl set f [open tclIndex r] - set dat [split [string trim [read $f]] "\n"] - set len [llength $dat] - set result [lsort [lrange $dat [expr {$len-2}] [expr {$len-1}]]] - close $f - set result -} {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}} - -removeFile [file join pkg samename.tcl] - -makeFile { -set dollar1 "this string contains an unescaped dollar sign -> \\$foo" -set dollar2 "this string contains an escaped dollar sign -> \$foo \\\$foo" -set bracket1 "this contains an unescaped bracket [NoSuchProc]" -set bracket2 "this contains an escaped bracket \[NoSuchProc\]" -set bracket3 "this contains nested unescaped brackets [[NoSuchProc]]" -proc testProc {} {} -} [file join pkg magicchar.tcl] - -test autoMkindex-5.1 {escape magic tcl chars in general code} { + lsort [lrange [split [string trim [read $f]] "\n"] end-1 end] +} -cleanup { + catch {close $f} + removeFile [file join pkg samename.tcl] + removeDirectory pkg +} -result {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}} + +test autoMkindex-5.1 {escape magic tcl chars in general code} -setup { file delete tclIndex + makeDirectory pkg + makeFile { + set dollar1 "this string contains an unescaped dollar sign -> \\$foo" + set dollar2 \ + "this string contains an escaped dollar sign -> \$foo \\\$foo" + set bracket1 "this contains an unescaped bracket [NoSuchProc]" + set bracket2 "this contains an escaped bracket \[NoSuchProc\]" + set bracket3 \ + "this contains nested unescaped brackets [[NoSuchProc]]" + proc testProc {} {} + } [file join pkg magicchar.tcl] set result {} - if { ![catch {auto_mkindex . pkg/magicchar.tcl}] } { - set f [open tclIndex r] - set dat [split [string trim [read $f]] "\n"] - set result [lindex $dat end] - close $f - } - set result -} {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]} - -removeFile [file join pkg magicchar.tcl] - -makeFile { -proc {[magic mojo proc]} {} {} -} [file join pkg magicchar2.tcl] - -test autoMkindex-5.2 {correctly locate auto loaded procs with []} { +} -body { + auto_mkindex . pkg/magicchar.tcl + set f [open tclIndex r] + lindex [split [string trim [read $f]] "\n"] end +} -cleanup { + catch {close $f} + removeFile [file join pkg magicchar.tcl] + removeDirectory pkg +} -result {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]} +test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup { file delete tclIndex + makeDirectory pkg + makeFile { + proc {[magic mojo proc]} {} {} + } [file join pkg magicchar2.tcl] set result {} - if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } { - # Make a slave interp to test the autoloading - set c [interp create] - $c eval {lappend auto_path [pwd]} - set result [$c eval {catch {{[magic mojo proc]}}}] - interp delete $c - } - set result -} 0 - -removeFile [file join pkg magicchar2.tcl] -removeDirectory pkg - + interp create slave +} -body { + auto_mkindex . pkg/magicchar2.tcl + # Make a slave interp to test the autoloading + slave eval {lappend auto_path [pwd]} + slave eval {catch {{[magic mojo proc]}}} +} -cleanup { + interp delete slave + removeFile [file join pkg magicchar2.tcl] + removeDirectory pkg +} -result 0 + # Clean up. unset result @@ -357,3 +334,9 @@ if {[file exists tclIndex]} { cd $origDir ::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/binary.test b/tests/binary.test index 79fdb92..fc3d0b3 100644 --- a/tests/binary.test +++ b/tests/binary.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: binary.test,v 1.41 2010/09/15 22:12:00 dkf Exp $ +# RCS: @(#) $Id: binary.test,v 1.43 2010/11/09 14:20:19 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest diff --git a/tests/chanio.test b/tests/chanio.test index 11bf23e..c191dfe 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: chanio.test,v 1.23.4.1 2010/12/01 16:42:36 kennykb Exp $ +# RCS: @(#) $Id: chanio.test,v 1.27 2011/01/17 11:27:28 nijtmans Exp $ if {[catch {package require tcltest 2}]} { chan puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -3932,7 +3932,7 @@ test chan-io-32.3 {Tcl_Read, negative byte count} -setup { chan read $f -1 } -returnCodes error -cleanup { chan close $f -} -result {bad argument "-1": should be "nonewline"} +} -result {expected non-negative integer but got "-1"} test chan-io-32.4 {Tcl_Read, positive byte count} -body { set f [open $path(longfile) r] string length [chan read $f 1024] diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 2213c57..068b6cd 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -10,9 +10,9 @@ # 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.68.4.1 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: cmdAH.test,v 1.70 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2.1 namespace import -force ::tcltest::* } @@ -236,14 +236,15 @@ test cmdAH-6.1 {Tcl_FileObjCmd: volumes} -returnCodes error -body { test cmdAH-6.2 {Tcl_FileObjCmd: volumes} -body { lindex [file volumes] 0 } -match glob -result ?* -test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} { +test cmdAH-6.3 {Tcl_FileObjCmd: volumes} -constraints unix -body { set volumeList [file volumes] - catch [list glob -nocomplain [lindex $volumeList 0]*] -} {0} -test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win { + glob -nocomplain [lindex $volumeList 0]* +} -match glob -result * +test cmdAH-6.4 {Tcl_FileObjCmd: volumes} -constraints win -body { set volumeList [string tolower [file volumes]] - list [catch {lsearch $volumeList "c:/"} element] [expr {$element != -1}] [catch {list glob -nocomplain [lindex $volumeList $element]*}] -} {0 1 0} + set element [lsearch -exact $volumeList "c:/"] + list [expr {$element>-1}] [glob -nocomplain [lindex $volumeList $element]*] +} -match glob -result {1 *} # attributes test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup { @@ -251,11 +252,11 @@ test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup { catch {file delete -force $foofile} } -body { close [open $foofile w] - catch {file attributes $foofile} + file attributes $foofile } -cleanup { # We used [makeFile] so we undo with [removeFile] removeFile $foofile -} -result {0} +} -match glob -result * # dirname test cmdAH-8.1 {Tcl_FileObjCmd: dirname} -returnCodes error -body { @@ -497,33 +498,36 @@ test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform windows file tail {//foo/bar} } {} -test cmdAH-9.42 {Tcl_FileObjCmd: tail} testsetplatform { +test cmdAH-9.42 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { global env set temp $env(HOME) +} -body { set env(HOME) "/home/test" testsetplatform unix - set result [file tail ~] + file tail ~ +} -cleanup { set env(HOME) $temp - set result -} test -test cmdAH-9.43 {Tcl_FileObjCmd: tail} testsetplatform { +} -result test +test cmdAH-9.43 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { global env set temp $env(HOME) +} -body { set env(HOME) "~" testsetplatform unix - set result [file tail ~] + file tail ~ +} -cleanup { set env(HOME) $temp - set result -} {} -test cmdAH-9.44 {Tcl_FileObjCmd: tail} testsetplatform { +} -result {} +test cmdAH-9.44 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { global env set temp $env(HOME) +} -body { set env(HOME) "/home/test" testsetplatform windows - set result [file tail ~] + file tail ~ +} -cleanup { set env(HOME) $temp - set result -} test +} -result test test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail {f.oo\bar/baz.bat} @@ -923,10 +927,10 @@ test cmdAH-19.7 {Tcl_FileObjCmd: nativename} -body { test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} { file exists ~nOsUcHuSeR } 0 -test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} { - # should probably be 0 in fact... - catch {file nativename ~nOsUcHuSeR} -} 1 +test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} -body { + # should probably be a non-error in fact... + file nativename ~nOsUcHuSeR +} -returnCodes error -match glob -result * # The test below has to be done in /tmp rather than the current directory in # order to guarantee (?) a local file system: some NFS file systems won't do # the stuff below correctly. @@ -963,7 +967,7 @@ test cmdAH-20.1 {Tcl_FileObjCmd: atime} -returnCodes error -body { file atime a b c } -result {wrong # args: should be "file atime name ?time?"} test cmdAH-20.2 {Tcl_FileObjCmd: atime} -setup { - catch {unset stat} + unset -nocomplain stat } -body { file stat $gorpfile stat list [expr {[file mtime $gorpfile] == $stat(mtime)}] \ @@ -1031,13 +1035,13 @@ test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body { file lstat a b c } -result {wrong # args: should be "file lstat name varName"} test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup { - catch {unset stat} + unset -nocomplain stat } -constraints {unix nonPortable} -body { file lstat $linkfile stat lsort [array names stat] } -result {atime ctime dev gid ino mode mtime nlink size type uid} test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup { - catch {unset stat} + unset -nocomplain stat } -constraints {unix nonPortable} -body { file lstat $linkfile stat list $stat(nlink) [expr $stat(mode)&0777] $stat(type) @@ -1047,12 +1051,12 @@ test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} { $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup { - catch {unset x} + unset -nocomplain x } -body { set x 44 list [catch {file lstat $gorpfile x} msg] $msg $errorCode } -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}} -catch {unset stat} +unset -nocomplain stat # mkdir set dirA [file join [temporaryDirectory] a] set dirB [file join [temporaryDirectory] a] @@ -1128,7 +1132,7 @@ test cmdAH-24.2 {Tcl_FileObjCmd: mtime} -setup { } } -result {1} test cmdAH-24.3 {Tcl_FileObjCmd: mtime} -setup { - catch {unset stat} + unset -nocomplain stat } -body { file stat $gorpfile stat list [expr {[file mtime $gorpfile] == $stat(mtime)}] \ @@ -1294,7 +1298,7 @@ test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body { file stat _bogus_ a b } -result {wrong # args: should be "file stat name varName"} test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup { - catch {unset stat} + unset -nocomplain stat set stat(blocks) [set stat(blksize) {}] } -body { file stat $gorpfile stat @@ -1302,13 +1306,13 @@ test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup { lsort [array names stat] } -result {atime ctime dev gid ino mode mtime nlink size type uid} test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup { - catch {unset stat} + unset -nocomplain stat } -body { file stat $gorpfile stat list $stat(nlink) $stat(size) $stat(type) } -result {1 12 file} test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup { - catch {unset stat} + unset -nocomplain stat } -body { file stat $gorpfile stat expr {$stat(mode) & 0o777} @@ -1317,7 +1321,7 @@ test cmdAH-28.6 {Tcl_FileObjCmd: stat} { list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode } {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup { - catch {unset x} + unset -nocomplain x } -returnCodes error -body { set x 44 file stat $gorpfile x @@ -1371,7 +1375,7 @@ test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup { } -cleanup { removeFile $filename } -result 1 -catch {unset stat} +unset -nocomplain stat # type test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body { @@ -1513,7 +1517,7 @@ test cmdAH-32.2 {file tempfile - returns a read/write channel} -body { catch {close $f} } -result ok test cmdAH-32.3 {file tempfile - makes filenames} -setup { - catch {unset name} + unset -nocomplain name } -body { set result [info exists name] set f [file tempfile name] @@ -1556,7 +1560,7 @@ interp delete simpleInterp # cleanup catch {testsetplatform $platform} -catch {unset platform} +unset -nocomplain platform # Tcl_ForObjCmd is tested in for.test diff --git a/tests/cmdIL.test b/tests/cmdIL.test index ca81ea5..b806e65 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.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: cmdIL.test,v 1.43 2009/12/22 19:49:29 dkf Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.44 2010/12/27 00:01:07 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -458,6 +458,9 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body { } -result 0 -cleanup { rename test_lsort "" } +test cmdIL-5.6 {lsort with multiple list-style index options} { + lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}} +} {{a b} {b e} {c d}} # Compiled version test cmdIL-6.1 {lassign command syntax} -returnCodes error -body { diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index c7f6e44..78bb329 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.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: cmdMZ.test,v 1.30 2010/04/05 19:44:45 ferrieux Exp $ +# RCS: @(#) $Id: cmdMZ.test,v 1.31 2011/01/01 15:14:43 dkf Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." @@ -38,7 +38,7 @@ namespace eval ::tcl::test::cmdMZ { return 1 } customMatch listGlob [namespace which ListGlobMatch] - + # Tcl_PwdObjCmd test cmdMZ-1.1 {Tcl_PwdObjCmd} -returnCodes error -body { @@ -166,35 +166,31 @@ test cmdMZ-return-2.13 {return option handling} -body { test cmdMZ-return-2.14 {return option handling} -body { return -level 0 -code error -options {-code foo -options {-code break}} } -returnCodes break -result {} -test cmdMZ-return-2.15 {return opton handling} -setup { - proc p {} { - return -code error -errorcode {a b} c - } -} -body { - list [catch p result] $result $::errorCode -} -cleanup { - rename p {} -} -result {1 c {a b}} -test cmdMZ-return-2.16 {return opton handling} -setup { - proc p {} { - return -code error -errorcode [list a b] c - } -} -body { - list [catch p result] $result $::errorCode -} -cleanup { - rename p {} -} -result {1 c {a b}} -test cmdMZ-return-2.17 {return opton handling} -setup { - proc p {} { - return -code error -errorcode a\ b c - } -} -body { - list [catch p result] $result $::errorCode -} -cleanup { - rename p {} -} -result {1 c {a b}} +test cmdMZ-return-2.15 {return opton handling} { + list [catch { + apply {{} { + return -code error -errorcode {a b} c + }} + } result] $result $::errorCode +} {1 c {a b}} +test cmdMZ-return-2.16 {return opton handling} { + list [catch { + apply {{} { + return -code error -errorcode [list a b] c + }} + } result] $result $::errorCode +} {1 c {a b}} +test cmdMZ-return-2.17 {return opton handling} { + list [catch { + apply {{} { + return -code error -errorcode a\ b c + }} + } result] $result $::errorCode +} {1 c {a b}} test cmdMZ-return-2.18 {return option handling} { - list [catch {return -code error -errorstack [list CALL a CALL b] yo} -> foo] [dictSort $foo] [info errorstack] + list [catch { + return -code error -errorstack [list CALL a CALL b] yo + } -> foo] [dictSort $foo] [info errorstack] } {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}} # Check that the result of a [return -options $opts $result] is @@ -349,7 +345,7 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { "time {error foo}"}} # The tests for Tcl_WhileObjCmd are in while.test - + # cleanup cleanupTests } diff --git a/tests/compExpr.test b/tests/compExpr.test index c3e68c1..afa3b56 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -1,17 +1,17 @@ -# This file contains a collection of tests for the procedures in the -# file tclCompExpr.c. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for the procedures in the file +# tclCompExpr.c. Sourcing this file into Tcl runs the tests and generates +# output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compExpr.test,v 1.17 2008/01/16 21:54:33 dgp Exp $ +# RCS: @(#) $Id: compExpr.test,v 1.18 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest +if {"::tcltest" ni [namespace children]} { + package require tcltest 2 namespace import -force ::tcltest::* } @@ -25,7 +25,7 @@ if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1" testConstraint memory [llength [info commands memory]] catch {unset a} - + test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} { expr 1+2 } 3 @@ -35,17 +35,17 @@ test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} -body { test compExpr-1.3 {TclCompileExpr procedure, error compiling expr} -body { list [catch {expr "foo(123)"} msg] $msg } -match glob -result {1 {* "*foo"}} - test compExpr-1.4 {TclCompileExpr procedure, expr has no operators} { set a {0o00123} expr {$a} } 83 -test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} { - catch {unset a} +test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} -setup { + unset -nocomplain a +} -body { set a 27 expr {"foo$a" < "bar"} -} 0 +} -result 0 test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} -body { expr {"00[expr 1+]" + 17} } -returnCodes error -match glob -result * @@ -68,30 +68,33 @@ test compExpr-2.7 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} { test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} -body { expr {[foo "bar"xxx] + 17} } -returnCodes error -match glob -result * -test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} { - catch {unset a} +test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup { + unset -nocomplain a +} -body { set a 123 expr {$a*2} -} 246 -test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} { - catch {unset a} - catch {unset b} +} -result 246 +test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup { + unset -nocomplain a + unset -nocomplain b +} -body { set a(george) martha set b geo expr {$a(${b}rge)} -} martha -test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} { - catch {unset a} - list [catch {expr {$a + 17}} msg] $msg -} {1 {can't read "a": no such variable}} +} -result martha +test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} -body { + unset -nocomplain a + expr {$a + 17} +} -returnCodes error -result {can't read "a": no such variable} test compExpr-2.12 {CompileSubExpr procedure, TCL_TOKEN_SUB_EXPR parse token} { expr {27||3? 3<<(1+4) : 4&&9} } 96 -test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} { - catch {unset a} +test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { + unset -nocomplain a +} -body { set a 15 list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg -} {0 1} +} -result {0 1} test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} { expr {5*6} } 30 @@ -149,11 +152,12 @@ test compExpr-2.31 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal o test compExpr-2.32 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} { expr {~4} } -5 -test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} { - catch {unset a} +test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} -setup { + unset -nocomplain a +} -body { set a 15 expr {$a==15} ;# compiled out-of-line to runtime call on Tcl_ExprObjCmd -} 1 +} -result 1 test compExpr-2.34 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { expr {+2} } 2 @@ -175,72 +179,84 @@ test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special test compExpr-2.40 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { expr {4-2} } 2 -test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { - catch {unset a} +test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { + unset -nocomplain a +} -body { set a true expr {0||$a} -} 1 -test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} { - catch {unset a} +} -result 1 +test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { + unset -nocomplain a +} -body { set a 15 list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg -} {0 1} -test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { - catch {unset a} +} -result {0 1} +test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { + unset -nocomplain a +} -body { set a false expr {3&&$a} -} 0 -test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { - catch {unset a} +} -result 0 +test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { + unset -nocomplain a +} -body { set a false expr {$a||1? 1 : 0} -} 1 -test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} { - catch {unset a} +} -result 1 +test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { + unset -nocomplain a +} -body { set a 15 list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg -} {0 54} +} -result {0 54} -test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} { - catch {unset a} +test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} -setup { + unset -nocomplain a +} -body { set a 2 expr {[set a]||0} -} 1 -test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} { - catch {unset a} +} -result 1 +test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} -setup { + unset -nocomplain a +} -body { set a no expr {$a&&1} -} 0 +} -result 0 test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} -body { expr {[expr *2]||0} } -returnCodes error -match glob -result * -test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} { - catch {unset a} - catch {unset b} +test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} -setup { + unset -nocomplain a + unset -nocomplain b +} -body { set a no set b true expr {$a || $b} -} 1 -test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} { - catch {unset a} +} -result 1 +test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup { + unset -nocomplain a +} -body { set a yes expr {$a || [exit]} -} 1 -test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} { - catch {unset a} +} -result 1 +test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup { + unset -nocomplain a +} -body { set a no expr {$a && [exit]} -} 0 -test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} { - catch {unset a} +} -result 0 +test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} -setup { + unset -nocomplain a +} -body { set a 2 expr {0||[set a]} -} 1 -test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} { - catch {unset a} +} -result 1 +test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} -setup { + unset -nocomplain a +} -body { set a no expr {1&&$a} -} 0 +} -result 0 test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} -body { expr {0||[expr %2]} } -returnCodes error -match glob -result * @@ -250,42 +266,48 @@ test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} { expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} } 1 -test compExpr-4.1 {CompileCondExpr procedure, simple test} { - catch {unset a} +test compExpr-4.1 {CompileCondExpr procedure, simple test} -setup { + unset -nocomplain a +} -body { set a 2 expr {($a > 1)? "ok" : "nope"} -} ok -test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} { - catch {unset a} +} -result ok +test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} -setup { + unset -nocomplain a +} -body { set a no expr {[set a]? 27 : -54} -} -54 +} -result -54 test compExpr-4.3 {CompileCondExpr procedure, error in test} -body { expr {[expr *2]? +1 : -1} } -returnCodes error -match glob -result * -test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} { - catch {unset a} +test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} -setup { + unset -nocomplain a +} -body { set a no expr {1? (27-2) : -54} -} 25 -test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} { - catch {unset a} +} -result 25 +test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} -setup { + unset -nocomplain a +} -body { set a no expr {1? $a : -54} -} no +} -result no test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} -body { expr {1? [expr *2] : -127} } -returnCodes error -match glob -result * -test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} { - catch {unset a} +test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} -setup { + unset -nocomplain a +} -body { set a no expr {(2-2)? -3.14159 : "nope"} -} nope -test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} { - catch {unset a} +} -result nope +test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} -setup { + unset -nocomplain a +} -body { set a 0o0123 expr {0? 42 : $a} -} 83 +} -result 83 test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} { list [catch {expr {1? 15 : [expr *2]}} msg] $msg } {0 15} @@ -294,8 +316,8 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { format %.6g [expr atan2(1.0, 2.0)] } 0.463648 test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body { - list [catch {expr {do_it()}} msg] $msg -} -match glob -result {1 {* "*do_it"}} + expr {do_it()} +} -returnCodes error -match glob -result {* "*do_it"} test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions { expr 3*T1()-1 } 368 @@ -303,8 +325,8 @@ test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathf expr T2()*3 } 1035 test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body { - list [catch {expr {atan2(1.0)}} msg] $msg -} -match glob -result {1 {too few arguments for math function*}} + expr {atan2(1.0)} +} -returnCodes error -match glob -result {too few arguments for math function*} test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} { format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))] } 9.97424 @@ -312,11 +334,11 @@ test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body { expr {sinh(2.*)} } -returnCodes error -match glob -result * test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body { - list [catch {expr {sinh(2.0, 3.0)}} msg] $msg -} -match glob -result {1 {too many arguments for math function*}} + expr {sinh(2.0, 3.0)} +} -returnCodes error -match glob -result {too many arguments for math function*} test compExpr-5.9 {CompileMathFuncCall procedure, too many arguments} -body { - list [catch {expr {0 <= rand(5.2)}} msg] $msg -} -match glob -result {1 {too many arguments for math function*}} + expr {0 <= rand(5.2)} +} -returnCodes error -match glob -result {too many arguments for math function*} test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -body { expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3 @@ -360,9 +382,14 @@ test compExpr-7.2 {[Bug 1869989]: expr parser memleak} -constraints memory -setu unset end i tmp rename getbytes {} } -result 0 - + # cleanup catch {unset a} catch {unset b} ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/compile.test b/tests/compile.test index 021c6fe..49df0aa 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -1,17 +1,17 @@ -# This file contains tests for the files tclCompile.c, tclCompCmds.c -# and tclLiteral.c +# This file contains tests for the files tclCompile.c, tclCompCmds.c and +# tclLiteral.c # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compile.test,v 1.51.4.1 2010/11/03 00:18:57 kennykb Exp $ +# RCS: @(#) $Id: compile.test,v 1.53 2011/01/01 15:14:43 dkf Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -29,9 +29,10 @@ catch {unset x} catch {unset y} catch {unset a} -test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} { +test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} -setup { catch {namespace delete test_ns_compile} catch {unset x} +} -body { set x 123 namespace eval test_ns_compile { proc set {args} { @@ -43,63 +44,70 @@ test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} { } } list [test_ns_compile::p] [set x] -} {{123 test_ns_compile::set} {123 test_ns_compile::set}} +} -result {{123 test_ns_compile::set} {123 test_ns_compile::set}} test compile-1.2 {TclCompileString, error result is reset if TclGetLong determines word isn't an integer} { proc p {x} {info commands 3m} list [catch {p} msg] $msg } {1 {wrong # args: should be "p x"}} -test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} { + +test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} -setup { catch {unset x} +} -body { set x 123 - list $::x [expr {[lsearch -exact [info globals] x] != 0}] -} {123 1} -test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} { + list $::x [expr {"x" in [info globals]}] +} -result {123 1} +test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} -setup { catch {unset y} +} -body { proc p {} { set ::y 789 return $::y } - list [p] $::y [expr {[lsearch -exact [info globals] y] != 0}] -} {789 789 1} -test compile-2.3 {TclCompileDollarVar: global array name with ::s} { + list [p] $::y [expr {"y" in [info globals]}] +} -result {789 789 1} +test compile-2.3 {TclCompileDollarVar: global array name with ::s} -setup { catch {unset a} +} -body { set ::a(1) 2 - list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {[lsearch -exact [info globals] a] != 0}] -} {2 3 3 1} -test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} { + list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {"a" in [info globals]}] +} -result {2 3 3 1} +test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} -setup { catch {unset a} +} -body { proc p {} { set ::a(1) 1 return $::a($::a(1)) } - list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}] -} {1 1 1} -test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} { + list [p] $::a(1) [expr {"a" in [info globals]}] +} -result {1 1 1} +test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} -setup { catch {unset a} +} -body { proc p {} { global a set a(1) 1 return ${a(1)}$::a(1)$a(1) } - list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}] -} {111 1 1} + list [p] $::a(1) [expr {"a" in [info globals]}] +} -result {111 1 1} -test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} { +test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} -setup { catch {unset a} +} -body { set a(1) xyzzyx proc p {} { global a catch {set x 123} a(1) } list [p] $a(1) -} {0 123} +} -result {0 123} test compile-3.2 {TclCompileCatchCmd: non-local variables} { set ::foo 1 proc catch-test {} { catch {set x 3} ::foo } catch-test - set ::foo + return $::foo } 3 test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} { proc catch-test {str} { @@ -107,7 +115,7 @@ test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} { error BAD } catch {catch-test error} ::foo - set ::foo + return $::foo } {GOOD} test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} { proc foo {} { @@ -158,7 +166,6 @@ test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*} -cleanup {namespace delete catchtest} } - test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 set j 0 @@ -187,29 +194,32 @@ test compile-5.2 {TclCompileForeachCmd: non-local variables} { set ::foo } 3 -test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} { +test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} -setup { catch {unset x} catch {unset y} +} -body { set x 123 proc p {} { set ::y 789 return $::y } - list $::x [expr {[lsearch -exact [info globals] x] != 0}] \ - [p] $::y [expr {[lsearch -exact [info globals] y] != 0}] -} {123 1 789 789 1} -test compile-6.2 {TclCompileSetCmd: global array names with ::s} { + list $::x [expr {"x" in [info globals]}] \ + [p] $::y [expr {"y" in [info globals]}] +} -result {123 1 789 789 1} +test compile-6.2 {TclCompileSetCmd: global array names with ::s} -setup { catch {unset a} +} -body { set ::a(1) 2 proc p {} { set ::a(1) 1 return $::a($::a(1)) } - list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}] -} {2 1 3 3 1} -test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} { + list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {"a" in [info globals]}] +} -result {2 1 3 3 1} +test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} -setup { catch {namespace delete test_ns_compile} catch {unset x} +} -body { namespace eval test_ns_compile { variable v hello variable arr @@ -217,7 +227,7 @@ test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} { set ::test_ns_compile::arr(1) 123 } list $::x $::test_ns_compile::arr(1) -} {hello 123} +} -result {hello 123} test compile-7.1 {TclCompileWhileCmd: command substituted test expression} { set i 0 @@ -258,53 +268,45 @@ test compile-10.1 {BLACKBOX: exception stack overflow} { } } {} -test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { - proc p {} { +test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { + apply {{} { # shared object - Interp result && Var 'r' set r [list foobar] # command that will add error to result lindex a bogus - } - list [catch {p} msg] $msg -} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} -test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { - proc p {} { set r [list foobar] ; string index a bogus } - list [catch {p} msg] $msg -} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} + }} +} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} +test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { + apply {{} { set r [list foobar] ; string index a bogus }} +} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { - proc p {} { set r [list foobar] ; string index a 0o9 } - list [catch {p} msg] $msg -} -match glob -result {1 {*invalid octal number*}} -test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { - proc p {} { set r [list foobar] ; array set var {one two many} } - list [catch {p} msg] $msg -} {1 {list must have an even number of elements}} -test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { - proc p {} { set r [list foobar] ; incr foo bar baz} - list [catch {p} msg] $msg -} {1 {wrong # args: should be "incr varName ?increment?"}} -test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { - proc p {} { set r [list foobar] ; incr} - list [catch {p} msg] $msg -} {1 {wrong # args: should be "incr varName ?increment?"}} + apply {{} { set r [list foobar] ; string index a 0o9 }} +} -returnCodes error -match glob -result {*invalid octal number*} +test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { + apply {{} { set r [list foobar] ; array set var {one two many} }} +} -returnCodes error -result {list must have an even number of elements} +test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { + apply {{} { set r [list foobar] ; incr foo bar baz}} +} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} +test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { + apply {{} { set r [list foobar] ; incr}} +} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { - proc p {} { set r [list foobar] ; expr !a } - p + apply {{} { set r [list foobar] ; expr !a }} } -returnCodes error -match glob -result * test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { - proc p {} { set r [list foobar] ; expr {!a} } - p + apply {{} { set r [list foobar] ; expr {!a} }} } -returnCodes error -match glob -result * -test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} { - proc p {} { set r [list foobar] ; llength "\{" } +test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { + apply {{} { set r [list foobar] ; llength "\{" }} list [catch {p} msg] $msg -} {1 {unmatched open brace in list}} +} -returnCodes error -result {unmatched open brace in list} # # Special section for tests of tclLiteral.c # The following tests check for incorrect memory handling in -# TclReleaseLiteral. They are only effective when tcl is compiled -# with TCL_MEM_DEBUG +# TclReleaseLiteral. They are only effective when tcl is compiled with +# TCL_MEM_DEBUG # # Special test for leak on interp delete [Bug 467523]. test compile-12.1 {testing literal leak on interp delete} -setup { @@ -328,9 +330,9 @@ test compile-12.1 {testing literal leak on interp delete} -setup { rename getbytes {} unset -nocomplain end i tmp leakedBytes } -result 0 -# Special test for a memory error in a preliminary fix of [Bug 467523]. -# It requires executing a helpfile. Presumably the child process is -# used because when this test fails, it crashes. +# Special test for a memory error in a preliminary fix of [Bug 467523]. It +# requires executing a helpfile. Presumably the child process is used because +# when this test fails, it crashes. test compile-12.2 {testing error on literal deletion} -constraints {memory exec} -body { set sourceFile [makeFile { for {set i 0} {$i < 5} {incr i} { @@ -355,29 +357,28 @@ test compile-12.3 {check for a buffer overrun} -body { test compile-12.4 {TclCleanupLiteralTable segfault} -body { # Tcl Bug 1001997 # Here, we're trying to test a case that causes a crash in - # TclCleanupLiteralTable. The conditions that we're trying to - # establish are: - # - TclCleanupLiteralTable is attempting to clean up a bytecode - # object in the literal table. - # - The bytecode object in question contains the only reference - # to another literal. + # TclCleanupLiteralTable. The conditions that we're trying to establish + # are: + # - TclCleanupLiteralTable is attempting to clean up a bytecode object in + # the literal table. + # - The bytecode object in question contains the only reference to another + # literal. # - The literal in question is in the same hash bucket as the bytecode # object, and immediately follows it in the chain. - # Since newly registered literals are added at the FRONT of the - # bucket chains, and since the bytecode object is registered before - # its literals, this is difficult to achieve. What we do is: - # (a) do a [namespace eval] of a string that's calculated to - # hash into the same bucket as a literal that it contains. - # In this case, the script and the variable 'bugbug' - # land in the same bucket. - # (b) do a [namespace eval] of a string that contains enough - # literals to force TclRegisterLiteral to rebuild the global - # literal table. The newly created hash buckets will contain - # the literals, IN REVERSE ORDER, thus putting the bytecode - # immediately ahead of 'bugbug' and 'bug4345bug'. The bytecode - # object will contain the only references to those two literals. - # (c) Delete the interpreter to invoke TclCleanupLiteralTable - # and tickle the bug. + # Since newly registered literals are added at the FRONT of the bucket + # chains, and since the bytecode object is registered before its literals, + # this is difficult to achieve. What we do is: + # (a) do a [namespace eval] of a string that's calculated to hash into + # the same bucket as a literal that it contains. In this case, the + # script and the variable 'bugbug' land in the same bucket. + # (b) do a [namespace eval] of a string that contains enough literals to + # force TclRegisterLiteral to rebuild the global literal table. The + # newly created hash buckets will contain the literals, IN REVERSE + # ORDER, thus putting the bytecode immediately ahead of 'bugbug' and + # 'bug4345bug'. The bytecode object will contain the only references + # to those two literals. + # (c) Delete the interpreter to invoke TclCleanupLiteralTable and tickle + # the bug. proc foo {} { set i [interp create] $i eval { @@ -411,9 +412,8 @@ test compile-12.4 {TclCleanupLiteralTable segfault} -body { rename foo {} } -result ok -# Special test for underestimating the maxStackSize required for a -# compiled command. A failure will cause a segfault in the child -# process. +# Special test for underestimating the maxStackSize required for a compiled +# command. A failure will cause a segfault in the child process. test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { set body {set x [list} for {set i 0} {$i < 3000} {incr i} { @@ -424,8 +424,8 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} { list [catch {exec [interpreter] << $script} msg] $msg } {0 OK} -# Special test for compiling tokens from a copy of the source -# string [Bug #599788] +# Special test for compiling tokens from a copy of the source string. [Bug +# 599788] test compile-14.1 {testing errors in element name; segfault?} {} { catch {set a([error])} msg1 catch {set bubba([join $abba $jubba]) $vol} msg2 @@ -434,34 +434,19 @@ test compile-14.1 {testing errors in element name; segfault?} {} { # Tests compile-15.* cover Tcl Bug 633204 test compile-15.1 {proper TCL_RETURN code from [return]} { - proc p {} {catch return} - set result [p] - rename p {} - set result + apply {{} {catch return}} } 2 test compile-15.2 {proper TCL_RETURN code from [return]} { - proc p {} {catch {return foo}} - set result [p] - rename p {} - set result + apply {{} {catch {return foo}}} } 2 test compile-15.3 {proper TCL_RETURN code from [return]} { - proc p {} {catch {return $::tcl_library}} - set result [p] - rename p {} - set result + apply {{} {catch {return $::tcl_library}}} } 2 test compile-15.4 {proper TCL_RETURN code from [return]} { - proc p {} {catch {return [info library]}} - set result [p] - rename p {} - set result + apply {{} {catch {return [info library]}}} } 2 test compile-15.5 {proper TCL_RETURN code from [return]} { - proc p {} {catch {set a 1}; return} - set result [p] - rename p {} - set result + apply {{} {catch {set a 1}; return}} } "" for {set noComp 0} {$noComp <= 1} {incr noComp} { @@ -536,17 +521,16 @@ test compile-16.17.$noComp {TclCompileScript: word expansion} $constraints { run {list {*}x y z} } {x y z} -# These tests note that expansion can in theory cause the number of -# arguments to a command to exceed INT_MAX, which is as big as objc -# is allowed to get. +# These tests note that expansion can in theory cause the number of arguments +# to a command to exceed INT_MAX, which is as big as objc is allowed to get. # -# In practice, it seems we will run out of memory before we confront -# this issue. Note that compiled operations run out of memory at -# smaller objc values than direct string evaluation. +# In practice, it seems we will run out of memory before we confront this +# issue. Note that compiled operations run out of memory at smaller objc +# values than direct string evaluation. # -# These tests are constrained as knownBug because they are likely -# to cause memory allocation panics somewhere, and we don't want -# panics in the test suite. +# These tests are constrained as knownBug because they are likely to cause +# memory allocation panics somewhere, and we don't want panics in the test +# suite. # test compile-16.18.$noComp {TclCompileScript: word expansion} -body { proc LongList {} {return [lrepeat [expr {1<<10}] x]} @@ -608,8 +592,8 @@ test compile-16.26.$noComp {TclCompileScript: word expansion, protected backslas } {a {\n} b} } ;# End of noComp loop -# These tests are messy because it wrecks the interpreter it runs in! -# They demonstrate issues arising from [FRQ 1101710] +# These tests are messy because it wrecks the interpreter it runs in! They +# demonstrate issues arising from [FRQ 1101710] test compile-17.1 {Command interpretation binding for compiled code} -constraints knownBug -setup { set i [interp create] } -body { @@ -732,3 +716,8 @@ catch {unset y} catch {unset a} ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/concat.test b/tests/concat.test index c369340..8988bb0 100644 --- a/tests/concat.test +++ b/tests/concat.test @@ -1,23 +1,23 @@ # Commands covered: concat # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: concat.test,v 1.6 2004/05/19 10:55:05 dkf Exp $ +# RCS: @(#) $Id: concat.test,v 1.7 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest namespace import -force ::tcltest::* } - + test concat-1.1 {simple concatenation} { concat a b c d e f g } {a b c d e f g} @@ -48,7 +48,12 @@ test concat-4.2 {pruning off extra white space} { test concat-4.3 {pruning off extra white space sets length correctly} { llength [concat { {{a}} }] } 1 - + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/dict.test b/tests/dict.test index b05208f..14e2fad 100644 --- a/tests/dict.test +++ b/tests/dict.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: dict.test,v 1.37.2.1 2010/10/02 16:04:29 kennykb Exp $ +# RCS: @(#) $Id: dict.test,v 1.38 2010/10/02 12:38:30 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 diff --git a/tests/error.test b/tests/error.test index 2e75c27..7465a44 100644 --- a/tests/error.test +++ b/tests/error.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: error.test,v 1.33.2.2 2010/12/01 16:42:36 kennykb Exp $ +# RCS: @(#) $Id: error.test,v 1.36 2010/11/04 15:00:41 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 diff --git a/tests/eval.test b/tests/eval.test index 98acd08..5d2813f 100644 --- a/tests/eval.test +++ b/tests/eval.test @@ -1,23 +1,23 @@ # Commands covered: eval # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: eval.test,v 1.9 2006/10/09 19:15:44 msofer Exp $ +# RCS: @(#) $Id: eval.test,v 1.10 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest namespace import -force ::tcltest::* } - + test eval-1.1 {single argument} { eval {format 22} } 22 @@ -80,7 +80,12 @@ test eval-3.4 {concatenating eval and canonical lists} { unset dummy eval $cmd $cmd2 } {1 2 3 4 5} - + # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/execute.test b/tests/execute.test index 4519890..bfb3e26 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -1,22 +1,22 @@ -# This file contains tests for the tclExecute.c source file. Tests appear -# in the same order as the C code that they test. The set of tests is -# currently incomplete since it currently includes only new tests for -# code changed for the addition of Tcl namespaces. Other execution- -# related tests appear in several other test files including -# namespace.test, basic.test, eval.test, for.test, etc. +# This file contains tests for the tclExecute.c source file. Tests appear in +# the same order as the C code that they test. The set of tests is currently +# incomplete since it currently includes only new tests for code changed for +# the addition of Tcl namespaces. Other execution-related tests appear in +# several other test files including namespace.test, basic.test, eval.test, +# for.test, etc. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: execute.test,v 1.35.2.1 2010/09/25 14:51:13 kennykb Exp $ +# RCS: @(#) $Id: execute.test,v 1.37 2011/01/01 14:44:32 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } @@ -498,10 +498,11 @@ test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeri # INST_PUSH_RESULT not tested # INST_PUSH_RETURN_CODE not tested -test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} { +test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} - catch {unset x} - catch {unset y} + unset -nocomplain x + unset -nocomplain y +} -body { namespace eval test_ns_1 { namespace export cmd1 proc cmd1 {args} {return "cmd1: $args"} @@ -515,11 +516,12 @@ test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} { list [namespace which -command ${x}${y}cmd1] \ [catch {namespace which -command ${x}${y}cmd2} msg] $msg \ [catch {namespace which -command ${x}${y}:cmd2} msg] $msg -} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}} -test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} { +} -result {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}} +test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} - catch {unset l} + unset -nocomplain l +} -body { proc foo {} { return "global foo" } @@ -536,11 +538,11 @@ test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is inval } } lappend l [test_ns_1::whichFoo] - set l -} {::foo ::test_ns_1::foo} -test execute-4.3 {Tcl_GetCommandFromObj, command never found} { +} -result {::foo ::test_ns_1::foo} +test execute-4.3 {Tcl_GetCommandFromObj, command never found} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename foo ""} +} -body { namespace eval test_ns_1 { proc foo {} { return "namespace foo" @@ -554,17 +556,18 @@ test execute-4.3 {Tcl_GetCommandFromObj, command never found} { list [namespace eval test_ns_1 {namespace which -command foo}] \ [rename test_ns_1::foo ""] \ [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg -} {::test_ns_1::foo {} 0 {}} +} -result {::test_ns_1::foo {} 0 {}} -test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} { +test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} - catch {unset l} + unset -nocomplain l +} -body { proc {} {} {return {}} {} set l {} lindex {} 0 {} -} {} +} -result {} test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} { proc {} {} {} @@ -600,7 +603,7 @@ test execute-6.4 {TclCompEvalObj: don't use cached expr bytecode [Bug 1899164]} } -cleanup { rename 0+0 {} } -result SCRIPT -test execute-6.5 {TclCompEvalObj: bytecode epoch validation} { +test execute-6.5 {TclCompEvalObj: bytecode epoch validation} -body { set script { llength {} } set result {} lappend result [if 1 $script] @@ -608,20 +611,22 @@ test execute-6.5 {TclCompEvalObj: bytecode epoch validation} { rename $origName llength.orig proc $origName {args} {return AHA!} lappend result [if 1 $script] +} -cleanup { rename $origName {} rename llength.orig $origName - set result -} {0 AHA!} -test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} { +} -result {0 AHA!} +test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} -body { proc foo {} {set a 1} set a untouched set result {} lappend result [foo] $a lappend result [if 1 [info body foo]] $a +} -cleanup { rename foo {} - set result -} {1 untouched 1 1} -test execute-6.7 {TclCompEvalObj: bytecode context validation} { +} -result {1 untouched 1 1} +test execute-6.7 {TclCompEvalObj: bytecode context validation} -setup { + namespace eval foo {} +} -body { set script { llength {} } namespace eval foo { proc llength {args} {return AHA!} @@ -629,10 +634,12 @@ test execute-6.7 {TclCompEvalObj: bytecode context validation} { set result {} lappend result [if 1 $script] lappend result [namespace eval foo $script] +} -cleanup { namespace delete foo - set result -} {0 AHA!} -test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} { +} -result {0 AHA!} +test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} -setup { + namespace eval foo {} +} -body { set script { llength {} } set result {} lappend result [namespace eval foo $script] @@ -640,20 +647,21 @@ test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} { proc llength {args} {return AHA!} } lappend result [namespace eval foo $script] +} -cleanup { namespace delete foo - set result -} {0 AHA!} -test execute-6.9 {TclCompEvalObj: bytecode interp validation} { - set script { llength {} } +} -result {0 AHA!} +test execute-6.9 {TclCompEvalObj: bytecode interp validation} -setup { interp create slave +} -body { + set script { llength {} } slave eval {proc llength args {return AHA!}} set result {} lappend result [if 1 $script] lappend result [slave eval $script] +} -cleanup { interp delete slave - set result -} {0 AHA!} -test execute-6.10 {TclCompEvalObj: bytecode interp validation} { +} -result {0 AHA!} +test execute-6.10 {TclCompEvalObj: bytecode interp validation} -body { set script { llength {} } interp create slave set result {} @@ -661,13 +669,14 @@ test execute-6.10 {TclCompEvalObj: bytecode interp validation} { interp delete slave interp create slave lappend result [slave eval $script] - interp delete slave - set result -} {0 0} -test execute-6.11 {Tcl_ExprObj: exprcode interp validation} testexprlongobj { +} -cleanup { + catch {interp delete slave} +} -result {0 0} +test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup { + interp create slave +} -constraints testexprlongobj -body { set e { [llength {}]+1 } set result {} - interp create slave load {} Tcltest slave interp alias {} e slave testexprlongobj lappend result [e $e] @@ -676,23 +685,24 @@ test execute-6.11 {Tcl_ExprObj: exprcode interp validation} testexprlongobj { load {} Tcltest slave interp alias {} e slave testexprlongobj lappend result [e $e] +} -cleanup { interp delete slave - set result -} {{This is a result: 1} {This is a result: 1}} -test execute-6.12 {Tcl_ExprObj: exprcode interp validation} { +} -result {{This is a result: 1} {This is a result: 1}} +test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup { + interp create slave +} -body { set e { [llength {}]+1 } set result {} - interp create slave interp alias {} e slave expr lappend result [e $e] interp delete slave interp create slave interp alias {} e slave expr lappend result [e $e] +} -cleanup { interp delete slave - set result -} {1 1} -test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} { +} -result {1 1} +test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body { set e { [llength {}]+1 } set result {} lappend result [expr $e] @@ -700,11 +710,13 @@ test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} { rename $origName llength.orig proc $origName {args} {return 1} lappend result [expr $e] +} -cleanup { rename $origName {} rename llength.orig $origName - set result -} {1 2} -test execute-6.14 {Tcl_ExprObj: exprcode context validation} { +} -result {1 2} +test execute-6.14 {Tcl_ExprObj: exprcode context validation} -setup { + namespace eval foo {} +} -body { set e { [llength {}]+1 } namespace eval foo { proc llength {args} {return 1} @@ -712,10 +724,12 @@ test execute-6.14 {Tcl_ExprObj: exprcode context validation} { set result {} lappend result [expr $e] lappend result [namespace eval foo {expr $e}] +} -cleanup { namespace delete foo - set result -} {1 2} -test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} { +} -result {1 2} +test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} -setup { + namespace eval foo {} +} -body { set e { [llength {}]+1 } set result {} lappend result [namespace eval foo {expr $e}] @@ -723,42 +737,43 @@ test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} { proc llength {args} {return 1} } lappend result [namespace eval foo {expr $e}] +} -cleanup { namespace delete foo - set result -} {1 2} -test execute-6.16 {Tcl_ExprObj: exprcode interp validation} { - set e { [llength {}]+1 } +} -result {1 2} +test execute-6.16 {Tcl_ExprObj: exprcode interp validation} -setup { interp create slave +} -body { + set e { [llength {}]+1 } interp alias {} e slave expr slave eval {proc llength args {return 1}} set result {} lappend result [expr $e] lappend result [e $e] +} -cleanup { interp delete slave - set result -} {1 2} -test execute-6.17 {Tcl_ExprObj: exprcode context validation} { - set e { $v } +} -result {1 2} +test execute-6.17 {Tcl_ExprObj: exprcode context validation} -body { proc foo e {set v 0; expr $e} proc bar e {set v 1; expr $e} + set e { $v } set result {} lappend result [foo $e] lappend result [bar $e] +} -cleanup { rename foo {} rename bar {} - set result -} {0 1} -test execute-6.18 {Tcl_ExprObj: exprcode context validation} { - set e { [llength $v] } +} -result {0 1} +test execute-6.18 {Tcl_ExprObj: exprcode context validation} -body { proc foo e {set v {}; expr $e} proc bar e {set v v; expr $e} + set e { [llength $v] } set result {} lappend result [foo $e] lappend result [bar $e] +} -cleanup { rename foo {} rename bar {} - set result -} {0 1} +} -result {0 1} test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} { set x 0x100000000 @@ -882,8 +897,8 @@ test execute-7.34 {Wide int handling} { } 1099511627776 test execute-8.1 {Stack protection} -setup { - # If [Bug #804681] has not been properly - # taken care of, this should segfault + # If [Bug #804681] has not been properly taken care of, this should + # segfault proc whatever args {llength $args} trace add variable ::errorInfo {write unset} whatever } -body { @@ -892,23 +907,27 @@ test execute-8.1 {Stack protection} -setup { trace remove variable ::errorInfo {write unset} whatever rename whatever {} } -returnCodes error -match glob -result * -test execute-8.2 {Stack restoration} -body { - # Test for [Bug #816641], correct restoration - # of the stack top after the stack is grown - proc f {args} { f bee bop } - catch f msg - set msg -} -setup { +test execute-8.2 {Stack restoration} -setup { # Avoid crashes when system stack size is limited (thread-enabled!) set limit [interp recursionlimit {}] interp recursionlimit {} 100 +} -body { + # Test for [Bug #816641], correct restoration of the stack top after the + # stack is grown + proc f {args} { f bee bop } + catch f msg + set msg } -cleanup { interp recursionlimit {} $limit } -result {too many nested evaluations (infinite loop?)} -test execute-8.3 {Stack restoration} -body { - # Test for [Bug #1055676], correct restoration - # of the stack top after the epoch is bumped and - # the stack is grown in a call from a nested evaluation +test execute-8.3 {Stack restoration} -setup { + # Avoid crashes when system stack size is limited (thread-enabled!) + set limit [interp recursionlimit {}] + interp recursionlimit {} 100 +} -body { + # Test for [Bug #1055676], correct restoration of the stack top after the + # epoch is bumped and the stack is grown in a call from a nested + # evaluation set arglst [string repeat "a " 1000] proc f {args} "f $arglst" proc run {} { @@ -919,10 +938,6 @@ test execute-8.3 {Stack restoration} -body { set msg } run -} -setup { - # Avoid crashes when system stack size is limited (thread-enabled!) - set limit [interp recursionlimit {}] - interp recursionlimit {} 100 } -cleanup { interp recursionlimit {} $limit } -result {too many nested evaluations (infinite loop?)} @@ -979,7 +994,6 @@ test execute-9.1 {Interp result resetting [Bug 1522803]} { test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130 } {48 {304 304}} - test execute-10.2 {Bug 2802881} -setup { interp create slave } -body { @@ -992,7 +1006,6 @@ test execute-10.2 {Bug 2802881} -setup { } -cleanup { interp delete slave } -returnCodes error -match glob -result * - test execute-10.3 {Bug 3072640} -setup { proc generate {n} { for {set i 0} {$i < $n} {incr i} { @@ -1014,6 +1027,22 @@ test execute-10.3 {Bug 3072640} -setup { rename coro {} } -result 4 +test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup { + interp create slave +} -body { + slave eval { + set x [lrepeat 1320 199] + for {set i 0} {$i < 20} {incr i} { + lappend x $i + lsort -integer $x + } + # Crashes on failure + return ok + } +} -cleanup { + interp delete slave +} -result ok + # cleanup if {[info commands testobj] != {}} { testobj freeallvars @@ -1031,4 +1060,5 @@ return # Local Variables: # mode: tcl +# fill-column: 78 # End: diff --git a/tests/expr.test b/tests/expr.test index de35640..cdda607 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.78.4.1 2010/10/28 19:42:20 kennykb Exp $ +# RCS: @(#) $Id: expr.test,v 1.79 2010/10/26 15:05:08 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 diff --git a/tests/fCmd.test b/tests/fCmd.test index 09e2622..ee7c5b3 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.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: fCmd.test,v 1.70.4.1 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.73 2010/12/09 15:31:02 dkf Exp $ # if {"::tcltest" ni [namespace children]} { @@ -172,7 +172,7 @@ append long $long append long $long append long $long append long $long - + test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup { cleanup } -body { @@ -2583,7 +2583,7 @@ test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win} -body { } return $r } -result {exists 1 readable 0 stat 0 {}} - + # cleanup cleanup ::tcltest::cleanupTests diff --git a/tests/fileName.test b/tests/fileName.test index d46391a..c7c591d 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -10,9 +10,9 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fileName.test,v 1.66 2010/01/05 18:58:36 dgp Exp $ +# RCS: @(#) $Id: fileName.test,v 1.67 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } @@ -42,7 +42,7 @@ global env if {[testConstraint testsetplatform]} { set platform [testgetplatform] } - + # Caution: when using 'testsetplatform' to test different file name platform # descriptions in this file, one must be very careful not to combine such # platform manipulation with commands like 'cd', 'pwd'. That is because the @@ -1434,7 +1434,7 @@ test filename-16.13 {windows specific globbing} {win sharedCdrive} { } //[info hostname]/c/globTest test filename-16.14 {windows specific globbing} {win} { cd [lindex [glob -types d -dir C:/ *] 0] - expr {[lsearch -exact [glob {{.,*}*}] ".."] != -1} + expr {".." in [glob {{.,*}*}]} } {1} test filename-16.15 {windows specific globbing} {win} { cd [lindex [glob -types d -dir C:/ *] 0] @@ -1529,7 +1529,6 @@ test fileName-20.4 {Bug 1750300} -setup { removeFile TAGS $d removeDirectory foo } -result 0 - test fileName-20.5 {Bug 2837800} -setup { set dd [makeDirectory isolate] set d [makeDirectory ./~foo $dd] @@ -1544,7 +1543,6 @@ test fileName-20.5 {Bug 2837800} -setup { removeDirectory ./~foo $dd removeDirectory isolate } -result ~foo/test - test fileName-20.6 {Bug 2837800} -setup { # Recall that we have $env(HOME) set so that references # to ~ point to [temporaryDirectory] @@ -1561,7 +1559,6 @@ test fileName-20.6 {Bug 2837800} -setup { removeDirectory isolate removeFile test ~ } -result {} - test fileName-20.7 {Bug 2806250} -setup { set savewd [pwd] cd [temporaryDirectory] @@ -1574,7 +1571,6 @@ test fileName-20.7 {Bug 2806250} -setup { removeDirectory isolate cd $savewd } -result 1 - test fileName-20.8 {Bug 2806250} -setup { set savewd [pwd] cd [temporaryDirectory] @@ -1587,8 +1583,7 @@ test fileName-20.8 {Bug 2806250} -setup { removeDirectory isolate cd $savewd } -result ./~test - -test fileName-20.9 {} -setup { +test fileName-20.9 {globbing for special chars} -setup { makeFile {} test ~ set d [makeDirectory isolate] set savewd [pwd] @@ -1600,8 +1595,7 @@ test fileName-20.9 {} -setup { removeDirectory isolate removeFile test ~ } -result ~/test - -test fileName-20.10 {} -setup { +test fileName-20.10 {globbing for special chars} -setup { set s [makeDirectory sub ~] makeFile {} fileName-20.10 $s set d [makeDirectory isolate] @@ -1615,7 +1609,7 @@ test fileName-20.10 {} -setup { removeFile fileName-20.10 $s removeDirectory sub ~ } -result ~/sub/fileName-20.10 - + # cleanup catch {file delete -force C:/globTest} cd [temporaryDirectory] diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 1691eb5..6ab554b 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -36,7 +36,7 @@ if {[testConstraint win]} { set vols [string map [list :/ {}] [file volumes]] for {set i 0} {$i < 26} {incr i} { set drive [format %c [expr {$i + 65}]] - if {[lsearch -exact $vols $drive] == -1} { + if {$drive ni $vols} { testConstraint unusedDrive 1 break } diff --git a/tests/http.test b/tests/http.test index b1ff1a0..5365d6d 100644 --- a/tests/http.test +++ b/tests/http.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: http.test,v 1.55.4.1 2010/10/28 19:42:20 kennykb Exp $ +# RCS: @(#) $Id: http.test,v 1.56 2010/10/28 16:38:12 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* diff --git a/tests/info.test b/tests/info.test index 810c57d..8c37f6d 100644 --- a/tests/info.test +++ b/tests/info.test @@ -13,7 +13,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.78.2.1 2010/12/01 16:42:37 kennykb Exp $ +# RCS: @(#) $Id: info.test,v 1.79 2010/11/15 21:34:54 andreas_kupries Exp $ if {{::tcltest} ni [namespace children]} { package require tcltest 2 diff --git a/tests/interp.test b/tests/interp.test index b401dcf..6057f51 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,9 +10,9 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.68.4.2 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: interp.test,v 1.71 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2.1 namespace import -force ::tcltest::* } @@ -147,7 +147,7 @@ test interp-3.8 {testing interp exists and interp slaves} -body { } -returnCodes error -result {wrong # args: should be "interp slaves ?path?"} test interp-3.9 {testing interp exists and interp slaves} { interp create {a a2} -safe - expr {[lsearch [interp slaves a] a2] >= 0} + expr {"a2" in [interp slaves a]} } 1 test interp-3.10 {testing interp exists and interp slaves} { interp exists {a a2} @@ -174,7 +174,7 @@ test interp-4.5 {testing interp delete} { interp create a interp create {a x1} interp delete {a x1} - expr {[lsearch [interp slaves a] x1] >= 0} + expr {"x1" in [interp slaves a]} } 0 test interp-4.6 {testing interp delete} { interp create c1 @@ -3569,7 +3569,7 @@ test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup { unset -nocomplain result interp delete a } -result {26 26} - + test interp-38.1 {interp debug one-way switch} -setup { catch {interp delete a} interp create a diff --git a/tests/io.test b/tests/io.test index 2077e1c..8a30260 100644 --- a/tests/io.test +++ b/tests/io.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.96.4.1 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: io.test,v 1.98 2011/01/17 11:27:28 nijtmans Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -3858,7 +3858,7 @@ test io-32.3 {Tcl_Read, negative byte count} { set l [list [catch {read $f -1} msg] $msg] close $f set l -} {1 {bad argument "-1": should be "nonewline"}} +} {1 {expected non-negative integer but got "-1"}} test io-32.4 {Tcl_Read, positive byte count} { set f [open $path(longfile) r] set x [read $f 1024] diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 920238c..09360ff 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioCmd.test,v 1.53 2010/08/03 20:06:47 dgp Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.54 2011/01/17 11:27:28 nijtmans Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -35,7 +35,7 @@ test iocmd-1.2 {puts command} { } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} test iocmd-1.3 {puts command} { list [catch {puts froboz -nonewline kablooie} msg] $msg -} {1 {bad argument "kablooie": should be "nonewline"}} +} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} test iocmd-1.4 {puts command} { list [catch {puts froboz hello} msg] $msg } {1 {can not find channel named "froboz"}} @@ -138,7 +138,7 @@ test iocmd-4.8 {read command with incorrect combination of arguments} { } {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} {TCL WRONGARGS}} test iocmd-4.9 {read command} { list [catch {read stdin foo} msg] $msg $::errorCode -} {1 {bad argument "foo": should be "nonewline"} NONE} +} {1 {expected non-negative integer but got "foo"} {TCL VALUE NUMBER}} test iocmd-4.10 {read command} { list [catch {read file107} msg] $msg $::errorCode } {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}} @@ -156,7 +156,7 @@ test iocmd-4.12 {read command} -setup { list [catch {read $f 12z} msg] $msg $::errorCode } -cleanup { close $f -} -result {1 {expected integer but got "12z"} {TCL VALUE NUMBER}} +} -result {1 {expected non-negative integer but got "12z"} {TCL VALUE NUMBER}} test iocmd-5.1 {seek command} -returnCodes error -body { seek diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 049b0ce..f5358c7 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.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: ioTrans.test,v 1.9.2.1 2010/12/01 16:42:37 kennykb Exp $ +# RCS: @(#) $Id: ioTrans.test,v 1.10 2010/11/24 11:56:57 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -102,7 +102,7 @@ set helperscript { eval $helperscript #puts <<[file channels]>> - + # ### ### ### ######### ######### ######### test iortrans-1.0 {chan, wrong#args} -returnCodes error -body { @@ -1036,7 +1036,7 @@ test iortrans-11.2 {delete interp of reflected transform} -setup { } interp delete slave } -result {} - + # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and receiving ## driver operations to the originator thread. @@ -1862,7 +1862,7 @@ test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} tcltest::threadReap tempdone } -result {Owner lost} - + # ### ### ### ######### ######### ######### cleanupTests diff --git a/tests/iogt.test b/tests/iogt.test index d2e1997..527b7b7 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -10,7 +10,7 @@ # Copyright (c) 2000 Andreas Kupries. # All rights reserved. # -# RCS: @(#) $Id: iogt.test,v 1.16.10.1 2010/12/01 16:42:37 kennykb Exp $ +# RCS: @(#) $Id: iogt.test,v 1.17 2010/11/24 11:56:57 dkf Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." @@ -354,7 +354,7 @@ proc asort {alist} { array set a $alist array_sget a } - + ######################################################################## test iogt-1.1 {stack/unstack} testchannel { @@ -793,7 +793,7 @@ test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body { } -cleanup { close $f } -result {xxxghi} - + # cleanup foreach file [list dummy dummyout __echo_srv__.tcl] { removeFile $file diff --git a/tests/lsearch.test b/tests/lsearch.test index 634adda..fd58978 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -1,23 +1,23 @@ # Commands covered: lsearch # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: lsearch.test,v 1.22 2008/09/29 12:25:21 dkf Exp $ +# RCS: @(#) $Id: lsearch.test,v 1.23 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest +if {"::tcltest" ni [namespace children]} { + package require tcltest 2 namespace import -force ::tcltest::* } - + set x {abcd bbcd 123 234 345} test lsearch-1.1 {lsearch command} { lsearch $x 123 @@ -47,9 +47,9 @@ test lsearch-2.4 {search modes} { test lsearch-2.5 {search modes} { lsearch -exact {foo bar cat} bar } 1 -test lsearch-2.6 {search modes} { - list [catch {lsearch -regexp {xyz bbcc *bc*} *bc*} msg] $msg -} {1 {couldn't compile regular expression pattern: quantifier operand invalid}} +test lsearch-2.6 {search modes} -returnCodes error -body { + lsearch -regexp {xyz bbcc *bc*} *bc* +} -result {couldn't compile regular expression pattern: quantifier operand invalid} test lsearch-2.7 {search modes} { lsearch -regexp {b.x ^bc xy bcx} ^bc } 3 @@ -59,9 +59,9 @@ test lsearch-2.8 {search modes} { test lsearch-2.9 {search modes} { lsearch -glob {b.x ^bc xy bcx} ^bc } 1 -test lsearch-2.10 {search modes} { - list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg -} {1 {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}} +test lsearch-2.10 {search modes} -returnCodes error -body { + lsearch -glib {b.x bx xy bcx} b.x +} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} test lsearch-2.11 {search modes with -nocase} { lsearch -exact -nocase {a b c A B C} A } 0 @@ -81,27 +81,27 @@ test lsearch-2.16 {search modes without -nocase} { lsearch -regexp {a b c A B C} ^A\$ } 3 -test lsearch-3.1 {lsearch errors} { - list [catch lsearch msg] $msg -} {1 {wrong # args: should be "lsearch ?-option value ...? list pattern"}} -test lsearch-3.2 {lsearch errors} { - list [catch {lsearch a} msg] $msg -} {1 {wrong # args: should be "lsearch ?-option value ...? list pattern"}} -test lsearch-3.3 {lsearch errors} { - list [catch {lsearch a b c} msg] $msg -} {1 {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}} -test lsearch-3.4 {lsearch errors} { - list [catch {lsearch a b c d} msg] $msg -} {1 {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}} -test lsearch-3.5 {lsearch errors} { - list [catch {lsearch "\{" b} msg] $msg -} {1 {unmatched open brace in list}} -test lsearch-3.6 {lsearch errors} { - list [catch {lsearch -index a b} msg] $msg -} {1 {"-index" option must be followed by list index}} -test lsearch-3.7 {lsearch errors} { - list [catch {lsearch -subindices -exact a b} msg] $msg -} {1 {-subindices cannot be used without -index option}} +test lsearch-3.1 {lsearch errors} -returnCodes error -body { + lsearch +} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"} +test lsearch-3.2 {lsearch errors} -returnCodes error -body { + lsearch a +} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"} +test lsearch-3.3 {lsearch errors} -returnCodes error -body { + lsearch a b c +} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} +test lsearch-3.4 {lsearch errors} -returnCodes error -body { + lsearch a b c d +} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices} +test lsearch-3.5 {lsearch errors} -returnCodes error -body { + lsearch "\{" b +} -result {unmatched open brace in list} +test lsearch-3.6 {lsearch errors} -returnCodes error -body { + lsearch -index a b +} -result {"-index" option must be followed by list index} +test lsearch-3.7 {lsearch errors} -returnCodes error -body { + lsearch -subindices -exact a b +} -result {-subindices cannot be used without -index option} test lsearch-4.1 {binary data} { lsearch -exact [list foo one\000two bar] bar @@ -300,12 +300,12 @@ test lsearch-10.2 {offset searching} { test lsearch-10.3 {offset searching} { lsearch -start end-4 {a b c a b c} a } 3 -test lsearch-10.4 {offset searching} { - list [catch {lsearch -start foobar {a b c a b c} a} msg] $msg -} {1 {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}} -test lsearch-10.5 {offset searching} { - list [catch {lsearch -start 1 2} msg] $msg -} {1 {missing starting index}} +test lsearch-10.4 {offset searching} -returnCodes error -body { + lsearch -start foobar {a b c a b c} a +} -result {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?} +test lsearch-10.5 {offset searching} -returnCodes error -body { + lsearch -start 1 2 +} -result {missing starting index} test lsearch-10.6 {binary search with offset} { set res {} for {set i 0} {$i < 100} {incr i} { @@ -453,15 +453,15 @@ test lsearch-19.5 {lsearch -sunindices option} { lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a } {{0 0 0} {1 0 0}} -test lsearch-20.1 {lsearch -index option, index larger than sublists} { - list [catch {lsearch -index 2 {{a c} {a b} {a a}} a} msg] $msg -} {1 {element 2 missing from sublist "a c"}} -test lsearch-20.2 {lsearch -index option, malformed index} { - list [catch {lsearch -index foo {{a c} {a b} {a a}} a} msg] $msg -} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}} -test lsearch-20.3 {lsearch -index option, malformed index} { - list [catch {lsearch -index \{ {{a c} {a b} {a a}} a} msg] $msg -} {1 {unmatched open brace in list}} +test lsearch-20.1 {lsearch -index option, index larger than sublists} -body { + lsearch -index 2 {{a c} {a b} {a a}} a +} -returnCodes error -result {element 2 missing from sublist "a c"} +test lsearch-20.2 {lsearch -index option, malformed index} -body { + lsearch -index foo {{a c} {a b} {a a}} a +} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?} +test lsearch-20.3 {lsearch -index option, malformed index} -body { + lsearch -index \{ {{a c} {a b} {a a}} a +} -returnCodes error -result {unmatched open brace in list} test lsearch-21.1 {lsearch shimmering crash} { set x 0 @@ -511,7 +511,7 @@ test lsearch-22.5 {lsearch -bisect, all equal} { test lsearch-22.6 {lsearch -sorted, all equal} { lsearch -sorted -integer {5 5 5 5} 5 } {0} - + # cleanup catch {unset res} catch {unset increasingIntegers} diff --git a/tests/main.test b/tests/main.test index d4b790a..98de6a9 100644 --- a/tests/main.test +++ b/tests/main.test @@ -1,6 +1,6 @@ # This file contains a collection of tests for generic/tclMain.c. # -# RCS: @(#) $Id: main.test,v 1.22.8.1 2010/12/01 16:42:37 kennykb Exp $ +# RCS: @(#) $Id: main.test,v 1.23 2010/11/18 15:50:54 nijtmans Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 804c233..f4d4598 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -14,9 +14,9 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace-old.test,v 1.14 2008/12/17 15:39:55 dkf Exp $ +# RCS: @(#) $Id: namespace-old.test,v 1.15 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2.2 namespace import -force ::tcltest::* } @@ -496,8 +496,8 @@ test namespace-old-7.1 {define test namespace} { } } {} test namespace-old-7.2 {uplevel can access namespace call frame} { - list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \ - [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}] + list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \ + [expr {"y" in [test_ns_uplevel::test_uplevel 1]}] } {1 1} test namespace-old-7.3 {uplevel can go beyond namespace call frame} { lsort [test_ns_uplevel::test_uplevel 2] @@ -506,8 +506,8 @@ test namespace-old-7.4 {uplevel can go up to global context} { expr {[test_ns_uplevel::test_uplevel 3] == [info globals]} } {1} test namespace-old-7.5 {absolute call frame references work too} { - list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \ - [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}] + list [expr {"x" in [test_ns_uplevel::test_uplevel #2]}] \ + [expr {"y" in [test_ns_uplevel::test_uplevel #2]}] } {1 1} test namespace-old-7.6 {absolute call frame references work too} { lsort [test_ns_uplevel::test_uplevel #1] diff --git a/tests/namespace.test b/tests/namespace.test index c1aef53..1c39b5c 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -1,23 +1,21 @@ # Functionality covered: this file contains a collection of tests for the -# procedures in tclNamesp.c that implement Tcl's basic support for -# namespaces. Other namespace-related tests appear in variable.test. +# procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic +# support for namespaces. Other namespace-related tests appear in +# variable.test. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# 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.78 2010/01/10 16:51:25 dkf Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} +# RCS: @(#) $Id: namespace.test,v 1.79 2011/01/01 15:14:43 dkf Exp $ +package require tcltest 2 +namespace import -force ::tcltest::* testConstraint memory [llength [info commands memory]] # @@ -27,7 +25,7 @@ testConstraint memory [llength [info commands memory]] # Clear out any namespaces called test_ns_* catch {namespace delete {*}[namespace children :: test_ns_*]} - + test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} { namespace children :: test_ns_* } {} @@ -47,7 +45,6 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} { } } lappend l [namespace current] - set l } {:: ::test_ns_1 ::test_ns_1::foo ::} test namespace-3.1 {Tcl_GetGlobalNamespace} { @@ -594,9 +591,8 @@ test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up onl namespace eval bar {} } namespace eval test_ns_1 { - set l [list [catch {namespace delete test_ns_2::bar} msg] $msg] + list [catch {namespace delete test_ns_2::bar} msg] $msg } - set l } {1 {unknown namespace "test_ns_2::bar" in namespace delete command}} test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval test_ns_1::test_ns_2 { @@ -815,7 +811,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} { set a 0 namespace eval test_ns_1 set a 1 namespace delete test_ns_1 - set a + return $a } 1 catch {unset a} catch {unset x} @@ -837,7 +833,6 @@ test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadow proc foo {} {return "foo in test_ns_1"} } lappend l [test_ns_1::trigger] - set l } {{global foo} {foo in test_ns_1}} test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} { namespace eval test_ns_2 { @@ -858,7 +853,6 @@ test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shado } } lappend l [test_ns_1::trigger] - set l } {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}} catch {unset l} catch {rename foo {}} @@ -890,7 +884,6 @@ test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} { namespace delete test_ns_1::test_ns_2 namespace eval test_ns_1::test_ns_2::test_ns_3 {} lappend l [test_ns_1::foo] - set l } {{} ::test_ns_1::test_ns_2::test_ns_3} test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { @@ -1420,16 +1413,17 @@ test namespace-39.3 {NamespaceExistsCmd error} { list [catch {namespace exists a b} msg] $msg } {1 {wrong # args: should be "namespace exists name"}} -test namespace-40.1 {Ignoring namespace proc "unknown"} { +test namespace-40.1 {Ignoring namespace proc "unknown"} -setup { rename unknown _unknown +} -body { proc unknown args {return global} namespace eval ns {proc unknown args {return local}} - set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]] + list [namespace eval ns aaa bbb] [namespace eval ns aaa] +} -cleanup { rename unknown {} rename _unknown unknown namespace delete ns - set l -} {global global} +} -result {global global} test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} { set res {} @@ -1447,7 +1441,6 @@ test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} { namespace delete ns set res } {0 1} - test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} { set res {} namespace eval ns {} @@ -1461,19 +1454,16 @@ test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} { namespace delete ns set res } {New proc is called} - test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} { set res {} namespace eval ns { variable b 0 } - proc ns::a {i} { variable b proc set args {return "New proc is called"} return [set b $i] } - set res [list [ns::a 1] $ns::b] namespace delete ns set res @@ -1512,18 +1502,18 @@ test namespace-42.3 {ensembles: basic} { namespace delete ns lappend result [info command ns::x1] } {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}} -test namespace-42.4 {ensembles: basic} { +test namespace-42.4 {ensembles: basic} -body { namespace eval ns { namespace export y* proc x1 {} {format 1} proc x2 {} {format 2} namespace ensemble create } - set result [list [catch {ns x} msg] $msg] + list [catch {ns x} msg] $msg +} -cleanup { namespace delete ns - set result -} {1 {unknown subcommand "x": namespace ::ns does not export any commands}} -test namespace-42.5 {ensembles: basic} { +} -result {1 {unknown subcommand "x": namespace ::ns does not export any commands}} +test namespace-42.5 {ensembles: basic} -body { namespace eval ns { namespace export x* proc x1 {} {format 1} @@ -1531,11 +1521,11 @@ test namespace-42.5 {ensembles: basic} { proc x3 {} {format 3} namespace ensemble create } - set result [list [catch {ns x} msg] $msg] + list [catch {ns x} msg] $msg +} -cleanup { namespace delete ns - set result -} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}} -test namespace-42.6 {ensembles: nested} { +} -result {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}} +test namespace-42.6 {ensembles: nested} -body { namespace eval ns { namespace export x* namespace eval x0 { @@ -1548,11 +1538,11 @@ test namespace-42.6 {ensembles: nested} { proc x3 {} {format 3} namespace ensemble create } - set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]] + list [ns x0 z] [ns x1] [ns x2] [ns x3] +} -cleanup { namespace delete ns - set result -} {0 1 2 3} -test namespace-42.7 {ensembles: nested} { +} -result {0 1 2 3} +test namespace-42.7 {ensembles: nested} -body { namespace eval ns { namespace export x* namespace eval x0 { @@ -1565,10 +1555,10 @@ test namespace-42.7 {ensembles: nested} { proc x3 {} {format 3} namespace ensemble create } - set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]] + list [ns x0 z] [ns x1] [ns x2] [ns x3] +} -cleanup { namespace delete ns - set result -} {{1 ::ns::x0::z} 1 2 3} +} -result {{1 ::ns::x0::z} 1 2 3} test namespace-42.8 {ensembles: [Bug 1670091]} -setup { proc demo args {} variable target [list [namespace which demo] x] @@ -1595,7 +1585,7 @@ test namespace-43.1 {ensembles: dict-driven} { rename ns {} lappend result [namespace ensemble exists ns] } {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0} -test namespace-43.2 {ensembles: dict-driven} { +test namespace-43.2 {ensembles: dict-driven} -body { namespace eval ns { namespace export x* proc x1 {args} {list 1 $args} @@ -1604,10 +1594,10 @@ test namespace-43.2 {ensembles: dict-driven} { a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .} } } - set result [list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]] + list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo] +} -cleanup { namespace delete ns - set result -} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}} +} -result {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}} set SETUP { namespace eval ns { namespace export a b @@ -2914,7 +2904,7 @@ test namespace-54.1 {leak on namespace deletion} -constraints {memory} \ rename getbytes {} unset i ns start end } -result 0 - + # cleanup catch {rename cmd1 {}} catch {unset l} diff --git a/tests/oo.test b/tests/oo.test index 6e24553..1954d1b 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -7,11 +7,11 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: oo.test,v 1.39.2.1 2010/12/01 16:42:37 kennykb Exp $ +# RCS: @(#) $Id: oo.test,v 1.44 2011/01/18 13:50:03 dkf Exp $ package require -exact TclOO 0.6.2 ;# Must match value in generic/tclOO.h -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 +package require tcltest 2 +if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* } @@ -2235,6 +2235,18 @@ test oo-22.1 {OO and info frame} -setup { } -cleanup { c destroy } -result {1 {{type source line * file * cmd {info frame 0} method frames class ::c level 0} {type source line * file * cmd {info frame 0} method frames object ::i level 0}} ::c} +test oo-22.2 {OO and info frame: Bug 3001438} -setup { + oo::class create c +} -body { + oo::define c method test {{x 1}} { + if {$x} {my test 0} + lsort {q w e r t y u i o p}; # Overwrite the Tcl stack + info frame 0 + } + [c new] test +} -match glob -cleanup { + c destroy +} -result {* cmd {info frame 0} method test class ::c level 0} # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { diff --git a/tests/package.test b/tests/package.test index eb24e99..4179a47 100644 --- a/tests/package.test +++ b/tests/package.test @@ -1,38 +1,55 @@ -# This file contains tests for the ::package::* commands. +# This file contains tests for the package and ::pkg::* commands. # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # +# Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. +# Copyright (c) 2011 Donal K. Fellows # -# RCS: @(#) $Id: package.test,v 1.3 2000/04/10 17:19:02 ericm Exp $ +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: package.test,v 1.4 2011/01/06 10:20:39 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest +if {"::tcltest" ni [namespace children]} { + package require tcltest 2 namespace import -force ::tcltest::* } -test package-1.1 {pkg::create gives error on insufficient args} { - catch {::pkg::create} -} 1 -test package-1.2 {pkg::create gives error on bad args} { - catch {::pkg::create -foo bar -bar baz -baz boo} -} 1 -test package-1.3 {pkg::create gives error on no value given} { - catch {::pkg::create -name foo -version 1.0 -source test.tcl -load} -} 1 -test package-1.4 {pkg::create gives error on no name given} { - catch {::pkg::create -version 1.0 -source test.tcl -load foo.so} -} 1 -test package-1.5 {pkg::create gives error on no version given} { - catch {::pkg::create -name foo -source test.tcl -load foo.so} -} 1 -test package-1.6 {pkg::create gives error on no source or load options} { - catch {::pkg::create -name foo -version 1.0 -version 2.0} -} 1 +# Do all this in a slave interp to avoid garbaging the package list +set i [interp create] +interp eval $i [list set argv $argv] +interp eval $i [list package require tcltest 2] +interp eval $i [list namespace import -force ::tcltest::*] +interp eval $i { + +package forget {*}[package names] +set oldPkgUnknown [package unknown] +package unknown {} +set oldPath $auto_path +set auto_path "" + +test package-1.1 {pkg::create gives error on insufficient args} -body { + ::pkg::create +} -returnCodes error -match glob -result {wrong # args: should be "*"} +test package-1.2 {pkg::create gives error on bad args} -body { + ::pkg::create -foo bar -bar baz -baz boo +} -returnCodes error -match glob -result {unknown option "bar": *} +test package-1.3 {pkg::create gives error on no value given} -body { + ::pkg::create -name foo -version 1.0 -source test.tcl -load +} -returnCodes error -match glob -result {value for "-load" missing: *} +test package-1.4 {pkg::create gives error on no name given} -body { + ::pkg::create -version 1.0 -source test.tcl -load foo.so +} -returnCodes error -match glob -result {value for "-name" missing: *} +test package-1.5 {pkg::create gives error on no version given} -body { + ::pkg::create -name foo -source test.tcl -load foo.so +} -returnCodes error -match glob -result {value for "-version" missing: *} +test package-1.6 {pkg::create gives error on no source or load options} -body { + ::pkg::create -name foo -version 1.0 -version 2.0 +} -returnCodes error -result {at least one of -load and -source must be given} test package-1.7 {pkg::create gives correct output for 1 direct source} { ::pkg::create -name foo -version 1.0 -source test.tcl } {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]} @@ -67,5 +84,1200 @@ test package-1.16 {pkg::create gives correct output for 1 direct, 1 lazy} { -source {test2.tcl {foo bar}} } {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list tclPkgSetup $dir foo 1.0 {{test2.tcl source {foo bar}}}]} +test package-2.1 {Tcl_PkgProvide procedure} { + package forget t + package provide t 2.3 +} {} +test package-2.2 {Tcl_PkgProvide procedure} -returnCodes error -setup { + package forget t +} -body { + package provide t 2.3 + package provide t 2.2 +} -result {conflicting versions provided for package "t": 2.3, then 2.2} +test package-2.3 {Tcl_PkgProvide procedure} -returnCodes error -setup { + package forget t +} -body { + package provide t 2.3 + package provide t 2.4 +} -result {conflicting versions provided for package "t": 2.3, then 2.4} +test package-2.4 {Tcl_PkgProvide procedure} -returnCodes error -setup { + package forget t +} -body { + package provide t 2.3 + package provide t 3.3 +} -result {conflicting versions provided for package "t": 2.3, then 3.3} +test package-2.5 {Tcl_PkgProvide procedure} -setup { + package forget t +} -body { + package provide t 2.3 + package provide t 2.3 +} -result {} +test package-2.6 {Tcl_PkgProvide procedure} { + package forget t + package provide t 2.3a1 +} {} + +set n 0 +foreach v { + 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1 + 2b4a1 2b3b2 +} { + test package-2.7.$n {Tcl_PkgProvide procedure} -setup { + package forget t + } -returnCodes error -body " + package provide t $v + " -result "expected version number but got \"$v\"" + incr n +} + +test package-3.1 {Tcl_PkgRequire procedure, picking best version} -setup { + package forget t + set x xxx +} -body { + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + package require t + return $x +} -result {3.4} +test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup { + package forget t + set x xxx +} -body { + foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + package require t + return $x +} -result {3.5} +test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup { + package forget t + set x xxx +} -body { + foreach i {3.5 2.1 2.3} { + package ifneeded t $i "set x $i; package provide t $i" + } + package require t 2.2 + return $x +} -result {2.3} +test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup { + package forget t + set x xxx +} -body { + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + package require -exact t 2.3 + return $x +} -result {2.3} +test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup { + package forget t + set x xxx +} -body { + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + package require t 2.1 + return $x +} -result {2.4} +test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup { + package forget t +} -returnCodes error -body { + package unknown {} + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i" + } + package require t 2.5 +} -result {can't find package t 2.5} +test package-3.7 {Tcl_PkgRequire procedure, can't find suitable version} -setup { + package forget t +} -returnCodes error -body { + package unknown {} + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i" + } + package require t 4.1 +} -result {can't find package t 4.1} +test package-3.8 {Tcl_PkgRequire procedure, can't find suitable version} -setup { + package forget t +} -returnCodes error -body { + package unknown {} + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i" + } + package require -exact t 1.3 +} -result {can't find package t exactly 1.3} +test package-3.9 {Tcl_PkgRequire procedure, can't find suitable version} -setup { + package forget t +} -returnCodes error -body { + package unknown {} + package require t +} -result {can't find package t} +test package-3.10 {Tcl_PkgRequire procedure, error in ifneeded script} -setup { + package forget t +} -body { + package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"} + list [catch {package require t 2.1} msg] $msg $::errorInfo +} -match glob -result {1 {ifneeded test} {ifneeded test + while executing +"error "ifneeded test"" + ("package ifneeded*" script) + invoked from within +"package require t 2.1"}} +test package-3.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -setup { + package forget t + set x xxx +} -body { + package ifneeded t 2.1 "set x invoked" + list [catch {package require t 2.1} msg] $msg $x +} -match glob -result {1 * invoked} +test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup { + package forget t + set x xxx +} -body { + package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2" + package require t 1.2 + return $x +} -result {1.2} +test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup { + package forget t + set x xxx +} -body { + proc pkgUnknown args { + # args = name requirement + # requirement = v-v (for exact version) + global x + set x $args + package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0] + } + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i" + } + package unknown pkgUnknown + package require -exact t 1.5 + return $x +} -cleanup { + package unknown {} +} -result {t 1.5-1.5} +test package-3.14 {Tcl_PkgRequire procedure, "package unknown" support} -setup { + package forget t + set x xxx +} -body { + proc pkgUnknown args { + package ifneeded t 1.2 "set x loaded; package provide t 1.2" + } + package unknown pkgUnknown + list [package require t] $x +} -cleanup { + package unknown {} +} -result {1.2 loaded} +test package-3.15 {Tcl_PkgRequire procedure, "package unknown" support} -setup { + package forget {a b} + package unknown pkgUnknown + set x xxx +} -body { + proc pkgUnknown args { + global x + set x $args + package provide [lindex $args 0] 2.0 + } + package require {a b} + return $x +} -cleanup { + package unknown {} +} -result {{a b} 0-} +test package-3.16 {Tcl_PkgRequire procedure, "package unknown" error} -setup { + package forget t +} -body { + proc pkgUnknown args { + error "testing package unknown" + } + package unknown pkgUnknown + list [catch {package require t} msg] $msg $::errorInfo +} -cleanup { + package unknown {} +} -result {1 {testing package unknown} {testing package unknown + while executing +"error "testing package unknown"" + (procedure "pkgUnknown" line 2) + invoked from within +"pkgUnknown t 0-" + ("package unknown" script) + invoked from within +"package require t"}} +test package-3.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} -setup { + package forget t + set x xxx +} -body { + proc pkgUnknown args { + global x + set x $args + } + foreach i {1.4 3.4 2.3 2.4 2.2} { + package ifneeded t $i "set x $i" + } + package unknown pkgUnknown + list [catch {package require -exact t 1.5} msg] $msg $x +} -cleanup { + package unknown {} +} -result {1 {can't find package t exactly 1.5} {t 1.5-1.5}} +test package-3.18 {Tcl_PkgRequire procedure, version checks} -setup { + package forget t +} -body { + package provide t 2.3 + package require t +} -result {2.3} +test package-3.19 {Tcl_PkgRequire procedure, version checks} -setup { + package forget t +} -body { + package provide t 2.3 + package require t 2.1 +} -result {2.3} +test package-3.20 {Tcl_PkgRequire procedure, version checks} -setup { + package forget t +} -body { + package provide t 2.3 + package require t 2.3 +} -result {2.3} +test package-3.21 {Tcl_PkgRequire procedure, version checks} -setup { + package forget t +} -returnCodes error -body { + package provide t 2.3 + package require t 2.4 +} -result {version conflict for package "t": have 2.3, need 2.4} +test package-3.22 {Tcl_PkgRequire procedure, version checks} -setup { + package forget t +} -returnCodes error -body { + package provide t 2.3 + package require t 1.2 +} -result {version conflict for package "t": have 2.3, need 1.2} +test package-3.23 {Tcl_PkgRequire procedure, version checks} -setup { + package forget t +} -body { + package provide t 2.3 + package require -exact t 2.3 +} -result {2.3} +test package-3.24 {Tcl_PkgRequire procedure, version checks} -setup { + package forget t +} -returnCodes error -body { + package provide t 2.3 + package require -exact t 2.2 +} -result {version conflict for package "t": have 2.3, need exactly 2.2} +test package-3.25 {Tcl_PkgRequire procedure, error in ifneeded script} -setup { + package forget t +} -body { + package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI} + list [catch {package require t 2.1} msg] $msg $::errorInfo +} -match glob -result {1 {ifneeded test} {EI + ("package ifneeded*" script) + invoked from within +"package require t 2.1"}} +test package-3.26 {Tcl_PkgRequire procedure, error in ifneeded script} -setup { + package forget t +} -body { + package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}} + list [catch {package require t 2.1} msg] $msg $::errorInfo +} -match glob -result {1 {ifneeded test} {EI + ("foreach" body line 1) + invoked from within +"foreach x 1 {error "ifneeded test" EI}" + ("package ifneeded*" script) + invoked from within +"package require t 2.1"}} +test package-3.27 {Tcl_PkgRequire: circular dependency} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package require foo 1} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {circular package dependency:*} +test package-3.28 {Tcl_PkgRequire: circular dependency} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package require foo 2} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {circular package dependency:*} +test package-3.29 {Tcl_PkgRequire: circular dependency} -setup { + package forget foo + package forget bar +} -body { + package ifneeded foo 1 {package require bar 1; package provide foo 1} + package ifneeded bar 1 {package require foo 1; package provide bar 1} + package require foo 1 +} -cleanup { + package forget foo + package forget bar +} -returnCodes error -match glob -result {circular package dependency:*} +test package-3.30 {Tcl_PkgRequire: circular dependency} -setup { + package forget foo + package forget bar +} -body { + package ifneeded foo 1 {package require bar 1; package provide foo 1} + package ifneeded foo 2 {package provide foo 2} + package ifneeded bar 1 {package require foo 2; package provide bar 1} + package require foo 1 +} -cleanup { + package forget foo + package forget bar +} -returnCodes error -match glob -result {circular package dependency:*} +test package-3.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package provide foo 1; error foo} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result foo +test package-3.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package provide foo 1; error foo} + catch {package require foo 1} + package provide foo +} -cleanup { + package forget foo +} -result {} +test package-3.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package provide foo 2} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test package-3.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {package provide foo 1.1} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test package-3.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1.1 {package provide foo 1} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test package-3.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1.1 {package provide foo 1} + package require foo 1.1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test package-3.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob -result {attempt to provide package * failed:*} +test package-3.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {break} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob \ +-result {attempt to provide package * failed: bad return code:*} +test package-3.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {continue} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob \ +-result {attempt to provide package * failed: bad return code:*} +test package-3.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {return} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob \ +-result {attempt to provide package * failed: bad return code:*} +test package-3.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1 {return -level 0 -code 10} + package require foo 1 +} -cleanup { + package forget foo +} -returnCodes error -match glob \ +-result {attempt to provide package * failed: bad return code:*} +test package-3.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {package provide foo 2 ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result * +test package-3.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {break ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result {bad return code:*} +test package-3.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {continue ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result {bad return code:*} +test package-3.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {return ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result {bad return code:*} +test package-3.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo + set saveUnknown [package unknown] + package unknown {return -level 0 -code 10 ;#} +} -body { + package require foo 1 +} -cleanup { + package forget foo + package unknown $saveUnknown +} -returnCodes error -match glob -result {bad return code:*} +test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup { + package provide demo 1.2.3 +} -body { + package require -exact demo 1.2 +} -returnCodes error -cleanup { + package forget demo +} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2} +test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -setup { + package forget t + set x xxx +} -body { + foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} { + package ifneeded t $i "set x $i; package provide t $i" + } + package require t + return $x +} -result {3.4} +test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup { + package forget t + set x xxx +} -body { + foreach i {1.2b1 1.2 1.3a2 1.3} { + package ifneeded t $i "set x $i; package provide t $i" + } + package require t + return $x +} -result {1.3} +test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup { + package forget t + set x xxx +} -body { + foreach i {1.2b1 1.2 1.3 1.3a2} { + package ifneeded t $i "set x $i; package provide t $i" + } + package require t + return $x +} -result {1.3} + +test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body { + package +} -result {wrong # args: should be "package option ?arg ...?"} +test package-4.2 {Tcl_PackageCmd procedure, "forget" option} { + package forget {*}[package names] + package names +} {} +test package-4.3 {Tcl_PackageCmd procedure, "forget" option} { + package forget {*}[package names] + package forget foo +} {} +test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup { + package forget {*}[package names] + set result {} +} -body { + package ifneeded t 1.1 {first script} + package ifneeded t 2.3 {second script} + package ifneeded x 1.4 {x's script} + lappend result [lsort [package names]] [package versions t] + package forget t + lappend result [lsort [package names]] [package versions t] +} -result {{t x} {1.1 2.3} x {}} +test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup { + package forget {*}[package names] +} -body { + package ifneeded a 1.1 {first script} + package ifneeded b 2.3 {second script} + package ifneeded c 1.4 {third script} + package forget + set result [list [lsort [package names]]] + package forget a c + lappend result [lsort [package names]] +} -result {{a b c} b} +test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body { + # Test for Bug 415273 + package ifneeded a 1 "I should have been forgotten" + package forget no-such-package a + package ifneeded a 1 +} -cleanup { + package forget a +} -result {} +test package-4.6 {Tcl_PackageCmd procedure, "ifneeded" option} -body { + package ifneeded a +} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"} +test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body { + package ifneeded a b c d +} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"} +test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body { + package ifneeded t xyz +} -returnCodes error -result {expected version number but got "xyz"} +test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} { + package forget {*}[package names] + list [package ifneeded foo 1.1] [package names] +} {{} {}} +test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup { + package forget t +} -body { + package ifneeded t 1.4 "script for t 1.4" + list [package names] [package ifneeded t 1.4] [package versions t] +} -result {t {script for t 1.4} 1.4} +test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup { + package forget t +} -body { + package ifneeded t 1.4 "script for t 1.4" + list [package ifneeded t 1.5] [package names] [package versions t] +} -result {{} t 1.4} +test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup { + package forget t +} -body { + package ifneeded t 1.4 "script for t 1.4" + package ifneeded t 1.4 "second script for t 1.4" + list [package ifneeded t 1.4] [package names] [package versions t] +} -result {{second script for t 1.4} t 1.4} +test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup { + package forget t +} -body { + package ifneeded t 1.4 "script for t 1.4" + package ifneeded t 1.2 "second script" + package ifneeded t 3.1 "last script" + list [package ifneeded t 1.2] [package versions t] +} -result {{second script} {1.4 1.2 3.1}} +test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body { + package names a +} -returnCodes error -result {wrong # args: should be "package names"} +test package-4.15 {Tcl_PackageCmd procedure, "names" option} { + package forget {*}[package names] + package names +} {} +test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup { + package forget {*}[package names] +} -body { + package ifneeded x 1.2 {dummy} + package provide x 1.3 + package provide y 2.4 + catch {package require z 47.16} + lsort [package names] +} -result {x y} +test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body { + package provide +} -returnCodes error -result {wrong # args: should be "package provide package ?version?"} +test package-4.18 {Tcl_PackageCmd procedure, "provide" option} -body { + package provide a b c +} -returnCodes error -result {wrong # args: should be "package provide package ?version?"} +test package-4.19 {Tcl_PackageCmd procedure, "provide" option} -setup { + package forget t +} -body { + package provide t +} -result {} +test package-4.20 {Tcl_PackageCmd procedure, "provide" option} -setup { + package forget t +} -body { + package provide t 2.3 + package provide t +} -result {2.3} +test package-4.21 {Tcl_PackageCmd procedure, "provide" option} -setup { + package forget t +} -returnCodes error -body { + package provide t a.b +} -result {expected version number but got "a.b"} +test package-4.22 {Tcl_PackageCmd procedure, "require" option} -returnCodes error -body { + package require +} -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"} +test package-4.24 {Tcl_PackageCmd procedure, "require" option} -body { + package require -exact a b c + # Exact syntax: -exact name version + # name ?requirement ...? +} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"} +test package-4.26 {Tcl_PackageCmd procedure, "require" option} -body { + package require x a.b +} -returnCodes error -result {expected version number but got "a.b"} +test package-4.27 {Tcl_PackageCmd procedure, "require" option} -body { + package require -exact x a.b +} -returnCodes error -result {expected version number but got "a.b"} +test package-4.28 {Tcl_PackageCmd procedure, "require" option} -body { + package require -exact x +} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"} +test package-4.29 {Tcl_PackageCmd procedure, "require" option} -body { + package require -exact +} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"} +test package-4.30 {Tcl_PackageCmd procedure, "require" option} -setup { + package forget t +} -body { + package provide t 2.3 + package require t 2.1 +} -result {2.3} +test package-4.31 {Tcl_PackageCmd procedure, "require" option} -setup { + package forget t +} -body { + package require t +} -returnCodes error -result {can't find package t} +test package-4.32 {Tcl_PackageCmd procedure, "require" option} -setup { + package forget t +} -body { + package ifneeded t 2.3 "error {synthetic error}" + package require t 2.3 +} -returnCodes error -result {synthetic error} +test package-4.33 {Tcl_PackageCmd procedure, "unknown" option} -body { + package unknown a b +} -returnCodes error -result {wrong # args: should be "package unknown ?command?"} +test package-4.34 {Tcl_PackageCmd procedure, "unknown" option} { + package unknown "test script" + package unknown +} {test script} +test package-4.35 {Tcl_PackageCmd procedure, "unknown" option} { + package unknown "test script" + package unknown {} + package unknown +} {} +test package-4.36 {Tcl_PackageCmd procedure, "vcompare" option} -body { + package vcompare a +} -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"} +test package-4.37 {Tcl_PackageCmd procedure, "vcompare" option} -body { + package vcompare a b c +} -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"} +test package-4.38 {Tcl_PackageCmd procedure, "vcompare" option} -body { + package vcompare x.y 3.4 +} -returnCodes error -result {expected version number but got "x.y"} +test package-4.39 {Tcl_PackageCmd procedure, "vcompare" option} -body { + package vcompare 2.1 a.b +} -returnCodes error -result {expected version number but got "a.b"} +test package-4.40 {Tcl_PackageCmd procedure, "vcompare" option} { + package vc 2.1 2.3 +} {-1} +test package-4.41 {Tcl_PackageCmd procedure, "vcompare" option} { + package vc 2.2.4 2.2.4 +} {0} +test package-4.42 {Tcl_PackageCmd procedure, "versions" option} -body { + package versions +} -returnCodes error -result {wrong # args: should be "package versions package"} +test package-4.43 {Tcl_PackageCmd procedure, "versions" option} -body { + package versions a b +} -returnCodes error -result {wrong # args: should be "package versions package"} +test package-4.44 {Tcl_PackageCmd procedure, "versions" option} -body { + package forget t + package versions t +} -result {} +test package-4.45 {Tcl_PackageCmd procedure, "versions" option} -setup { + package forget t +} -body { + package provide t 2.3 + package versions t +} -result {} +test package-4.46 {Tcl_PackageCmd procedure, "versions" option} -setup { + package forget t +} -body { + package ifneeded t 2.3 x + package ifneeded t 2.4 y + package versions t +} -result {2.3 2.4} +test package-4.47 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { + package vsatisfies a +} -returnCodes error -result {wrong # args: should be "package vsatisfies version ?requirement ...?"} +test package-4.49 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { + package vsatisfies x.y 3.4 +} -returnCodes error -result {expected version number but got "x.y"} +test package-4.50 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { + package vcompare 2.1 a.b +} -returnCodes error -result {expected version number but got "a.b"} +test package-4.51 {Tcl_PackageCmd procedure, "vsatisfies" option} { + package vs 2.3 2.1 +} {1} +test package-4.52 {Tcl_PackageCmd procedure, "vsatisfies" option} { + package vs 2.3 1.2 +} {0} +test package-4.53 {Tcl_PackageCmd procedure, "versions" option} -body { + package foo +} -returnCodes error -result {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies} +test package-4.54 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { + package vsatisfies 2.1 2.1-3.2-4.5 +} -returnCodes error -result {expected versionMin-versionMax but got "2.1-3.2-4.5"} +test package-4.55 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { + package vsatisfies 2.1 3.2-x.y +} -returnCodes error -result {expected version number but got "x.y"} +test package-4.56 {Tcl_PackageCmd procedure, "vsatisfies" option} -body { + package vsatisfies 2.1 x.y-3.2 +} -returnCodes error -result {expected version number but got "x.y"} + +# No tests for FindPackage; can't think up anything detectable errors. + +test package-5.1 {TclFreePackageInfo procedure} { + interp create slave + slave eval { + package ifneeded t 2.3 x + package ifneeded t 2.4 y + package ifneeded x 3.1 z + package provide q 4.3 + package unknown "will this get freed?" + } + interp delete slave +} {} +test package-5.2 {TclFreePackageInfo procedure} -body { + interp create foo + foo eval { + package ifneeded t 2.3 x + package ifneeded t 2.4 y + package ifneeded x 3.1 z + package provide q 4.3 + } + foo alias z kill + proc kill {} { + interp delete foo + } + foo eval package require x 3.1 +} -returnCodes error -match glob -result * + +test package-6.1 {CheckVersion procedure} { + package vcompare 1 2.1 +} -1 +test package-6.2 {CheckVersion procedure} -body { + package vcompare .1 2.1 +} -returnCodes error -result {expected version number but got ".1"} +test package-6.3 {CheckVersion procedure} -body { + package vcompare 111.2a.3 2.1 +} -returnCodes error -result {expected version number but got "111.2a.3"} +test package-6.4 {CheckVersion procedure} -body { + package vcompare 1.2.3. 2.1 +} -returnCodes error -result {expected version number but got "1.2.3."} +test package-6.5 {CheckVersion procedure} -body { + package vcompare 1.2..3 2.1 +} -returnCodes error -result {expected version number but got "1.2..3"} + +test package-7.1 {ComparePkgVersions procedure} { + package vcompare 1.23 1.22 +} {1} +test package-7.2 {ComparePkgVersions procedure} { + package vcompare 1.22.1.2.3 1.22.1.2.3 +} {0} +test package-7.3 {ComparePkgVersions procedure} { + package vcompare 1.21 1.22 +} {-1} +test package-7.4 {ComparePkgVersions procedure} { + package vcompare 1.21 1.21.2 +} {-1} +test package-7.5 {ComparePkgVersions procedure} { + package vcompare 1.21.1 1.21 +} {1} +test package-7.6 {ComparePkgVersions procedure} { + package vsatisfies 1.21.1 1.21 +} {1} +test package-7.7 {ComparePkgVersions procedure} { + package vsatisfies 2.22.3 1.21 +} {0} +test package-7.8 {ComparePkgVersions procedure} { + package vsatisfies 1 1 +} {1} +test package-7.9 {ComparePkgVersions procedure} { + package vsatisfies 2 1 +} {0} + +test package-8.1 {Tcl_PkgPresent procedure, any version} -setup { + package forget t +} -body { + package provide t 2.4 + package present t +} -result {2.4} +test package-8.2 {Tcl_PkgPresent procedure, correct version} -setup { + package forget t +} -body { + package provide t 2.4 + package present t 2.4 +} -result {2.4} +test package-8.3 {Tcl_PkgPresent procedure, satisfying version} -setup { + package forget t +} -body { + package provide t 2.4 + package present t 2.0 +} -result {2.4} +test package-8.4 {Tcl_PkgPresent procedure, not satisfying version} -setup { + package forget t +} -returnCodes error -body { + package provide t 2.4 + package present t 2.6 +} -result {version conflict for package "t": have 2.4, need 2.6} +test package-8.5 {Tcl_PkgPresent procedure, not satisfying version} -setup { + package forget t +} -returnCodes error -body { + package provide t 2.4 + package present t 1.0 +} -result {version conflict for package "t": have 2.4, need 1.0} +test package-8.6 {Tcl_PkgPresent procedure, exact version} -setup { + package forget t +} -body { + package provide t 2.4 + package present -exact t 2.4 +} -result {2.4} +test package-8.7 {Tcl_PkgPresent procedure, not exact version} -setup { + package forget t +} -returnCodes error -body { + package provide t 2.4 + package present -exact t 2.3 +} -result {version conflict for package "t": have 2.4, need exactly 2.3} +test package-8.8 {Tcl_PkgPresent procedure, unknown package} -body { + package forget t + package present t +} -returnCodes error -result {package t is not present} +test package-8.9 {Tcl_PkgPresent procedure, unknown package} -body { + package forget t + package present t 2.4 +} -returnCodes error -result {package t 2.4 is not present} +test package-8.10 {Tcl_PkgPresent procedure, unknown package} -body { + package forget t + package present -exact t 2.4 +} -returnCodes error -result {package t 2.4 is not present} +test package-8.11 {Tcl_PackageCmd procedure, "present" option} -body { + package present +} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"} +test package-8.12 {Tcl_PackageCmd procedure, "present" option} -body { + package present a b c +} -returnCodes error -result {expected version number but got "b"} +test package-8.13 {Tcl_PackageCmd procedure, "present" option} -body { + package present -exact a b c +} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"} +test package-8.14 {Tcl_PackageCmd procedure, "present" option} -body { + package present -bs a b +} -returnCodes error -result {expected version number but got "a"} +test package-8.15 {Tcl_PackageCmd procedure, "present" option} -body { + package present x a.b +} -returnCodes error -result {expected version number but got "a.b"} +test package-8.16 {Tcl_PackageCmd procedure, "present" option} -body { + package present -exact x a.b +} -returnCodes error -result {expected version number but got "a.b"} +test package-8.17 {Tcl_PackageCmd procedure, "present" option} -body { + package present -exact x +} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"} +test package-8.18 {Tcl_PackageCmd procedure, "present" option} -body { + package present -exact +} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"} + +set n 0 +foreach {r p vs vc} { + 8.5a0 8.5a5 1 -1 + 8.5a0 8.5b1 1 -1 + 8.5a0 8.5.1 1 -1 + 8.5a0 8.6a0 1 -1 + 8.5a0 8.6b0 1 -1 + 8.5a0 8.6.0 1 -1 + 8.5a6 8.5a5 0 1 + 8.5a6 8.5b1 1 -1 + 8.5a6 8.5.1 1 -1 + 8.5a6 8.6a0 1 -1 + 8.5a6 8.6b0 1 -1 + 8.5a6 8.6.0 1 -1 + 8.5b0 8.5a5 0 1 + 8.5b0 8.5b1 1 -1 + 8.5b0 8.5.1 1 -1 + 8.5b0 8.6a0 1 -1 + 8.5b0 8.6b0 1 -1 + 8.5b0 8.6.0 1 -1 + 8.5b2 8.5a5 0 1 + 8.5b2 8.5b1 0 1 + 8.5b2 8.5.1 1 -1 + 8.5b2 8.6a0 1 -1 + 8.5b2 8.6b0 1 -1 + 8.5b2 8.6.0 1 -1 + 8.5 8.5a5 1 1 + 8.5 8.5b1 1 1 + 8.5 8.5.1 1 -1 + 8.5 8.6a0 1 -1 + 8.5 8.6b0 1 -1 + 8.5 8.6.0 1 -1 + 8.5.0 8.5a5 0 1 + 8.5.0 8.5b1 0 1 + 8.5.0 8.5.1 1 -1 + 8.5.0 8.6a0 1 -1 + 8.5.0 8.6b0 1 -1 + 8.5.0 8.6.0 1 -1 + 10 8 0 1 + 8 10 0 -1 + 0.0.1.2 0.1.2 1 -1 +} { + test package-9.$n {package vsatisfies} { + package vsatisfies $p $r + } $vs + test package-10.$n {package vcompare} { + package vcompare $r $p + } $vc + incr n +} + +test package-11.0 {package vcompare at 32bit boundary} { + package vcompare [expr {1<<31}] [expr {(1<<31)-1}] +} 1 + +# Note: It is correct that the result of the very first test, i.e. "5.0 5.0a0" +# is 1, i.e. that version 5.0a0 satisfies a 5.0 requirement. + +# The requirement "5.0" internally translates first to "5.0-6", and then to +# its final form of "5.0a0-6a0". These translations are explicitly specified +# by the TIP (Search for "padded/extended internally with 'a0'"). This was +# done intentionally for exactly the tested case, that an alpha package can +# satisfy a requirement for the regular package. An example would be a package +# FOO requiring Tcl 8.X for its operation. It can be used with Tcl 8.Xa0. +# Without our translation that would not be possible. + +set n 0 +foreach {required provided satisfied} { + 5.0 5.0a0 1 + 5.0a0 5.0 1 + + 8.5a0- 8.5a5 1 + 8.5a0- 8.5b1 1 + 8.5a0- 8.5.1 1 + 8.5a0- 8.6a0 1 + 8.5a0- 8.6b0 1 + 8.5a0- 8.6.0 1 + 8.5a6- 8.5a5 0 + 8.5a6- 8.5b1 1 + 8.5a6- 8.5.1 1 + 8.5a6- 8.6a0 1 + 8.5a6- 8.6b0 1 + 8.5a6- 8.6.0 1 + 8.5b0- 8.5a5 0 + 8.5b0- 8.5b1 1 + 8.5b0- 8.5.1 1 + 8.5b0- 8.6a0 1 + 8.5b0- 8.6b0 1 + 8.5b0- 8.6.0 1 + 8.5b2- 8.5a5 0 + 8.5b2- 8.5b1 0 + 8.5b2- 8.5.1 1 + 8.5b2- 8.6a0 1 + 8.5b2- 8.6b0 1 + 8.5b2- 8.6.0 1 + 8.5- 8.5a5 1 + 8.5- 8.5b1 1 + 8.5- 8.5.1 1 + 8.5- 8.6a0 1 + 8.5- 8.6b0 1 + 8.5- 8.6.0 1 + 8.5.0- 8.5a5 0 + 8.5.0- 8.5b1 0 + 8.5.0- 8.5.1 1 + 8.5.0- 8.6a0 1 + 8.5.0- 8.6b0 1 + 8.5.0- 8.6.0 1 + 8.5a0-7 8.5a5 0 + 8.5a0-7 8.5b1 0 + 8.5a0-7 8.5.1 0 + 8.5a0-7 8.6a0 0 + 8.5a0-7 8.6b0 0 + 8.5a0-7 8.6.0 0 + 8.5a6-7 8.5a5 0 + 8.5a6-7 8.5b1 0 + 8.5a6-7 8.5.1 0 + 8.5a6-7 8.6a0 0 + 8.5a6-7 8.6b0 0 + 8.5a6-7 8.6.0 0 + 8.5b0-7 8.5a5 0 + 8.5b0-7 8.5b1 0 + 8.5b0-7 8.5.1 0 + 8.5b0-7 8.6a0 0 + 8.5b0-7 8.6b0 0 + 8.5b0-7 8.6.0 0 + 8.5b2-7 8.5a5 0 + 8.5b2-7 8.5b1 0 + 8.5b2-7 8.5.1 0 + 8.5b2-7 8.6a0 0 + 8.5b2-7 8.6b0 0 + 8.5b2-7 8.6.0 0 + 8.5-7 8.5a5 0 + 8.5-7 8.5b1 0 + 8.5-7 8.5.1 0 + 8.5-7 8.6a0 0 + 8.5-7 8.6b0 0 + 8.5-7 8.6.0 0 + 8.5.0-7 8.5a5 0 + 8.5.0-7 8.5b1 0 + 8.5.0-7 8.5.1 0 + 8.5.0-7 8.6a0 0 + 8.5.0-7 8.6b0 0 + 8.5.0-7 8.6.0 0 + 8.5a0-8.6.1 8.5a5 1 + 8.5a0-8.6.1 8.5b1 1 + 8.5a0-8.6.1 8.5.1 1 + 8.5a0-8.6.1 8.6a0 1 + 8.5a0-8.6.1 8.6b0 1 + 8.5a0-8.6.1 8.6.0 1 + 8.5a6-8.6.1 8.5a5 0 + 8.5a6-8.6.1 8.5b1 1 + 8.5a6-8.6.1 8.5.1 1 + 8.5a6-8.6.1 8.6a0 1 + 8.5a6-8.6.1 8.6b0 1 + 8.5a6-8.6.1 8.6.0 1 + 8.5b0-8.6.1 8.5a5 0 + 8.5b0-8.6.1 8.5b1 1 + 8.5b0-8.6.1 8.5.1 1 + 8.5b0-8.6.1 8.6a0 1 + 8.5b0-8.6.1 8.6b0 1 + 8.5b0-8.6.1 8.6.0 1 + 8.5b2-8.6.1 8.5a5 0 + 8.5b2-8.6.1 8.5b1 0 + 8.5b2-8.6.1 8.5.1 1 + 8.5b2-8.6.1 8.6a0 1 + 8.5b2-8.6.1 8.6b0 1 + 8.5b2-8.6.1 8.6.0 1 + 8.5-8.6.1 8.5a5 1 + 8.5-8.6.1 8.5b1 1 + 8.5-8.6.1 8.5.1 1 + 8.5-8.6.1 8.6a0 1 + 8.5-8.6.1 8.6b0 1 + 8.5-8.6.1 8.6.0 1 + 8.5.0-8.6.1 8.5a5 0 + 8.5.0-8.6.1 8.5b1 0 + 8.5.0-8.6.1 8.5.1 1 + 8.5.0-8.6.1 8.6a0 1 + 8.5.0-8.6.1 8.6b0 1 + 8.5.0-8.6.1 8.6.0 1 + 8.5a0-8.5a0 8.5a0 1 + 8.5a0-8.5a0 8.5b1 0 + 8.5a0-8.5a0 8.4 0 + 8.5b0-8.5b0 8.5a5 0 + 8.5b0-8.5b0 8.5b0 1 + 8.5b0-8.5b0 8.5.1 0 + 8.5-8.5 8.5a5 0 + 8.5-8.5 8.5b1 0 + 8.5-8.5 8.5 1 + 8.5-8.5 8.5.1 0 + 8.5.0-8.5.0 8.5a5 0 + 8.5.0-8.5.0 8.5b1 0 + 8.5.0-8.5.0 8.5.0 1 + 8.5.0-8.5.0 8.5.1 0 + 8.5.0-8.5.0 8.6a0 0 + 8.5.0-8.5.0 8.6b0 0 + 8.5.0-8.5.0 8.6.0 0 + 8.2 9 0 + 8.2- 9 1 + 8.2-8.5 9 0 + 8.2-9.1 9 1 + + 8.5-8.5 8.5b1 0 + 8.5a0-8.5 8.5b1 0 + 8.5a0-8.5.1 8.5b1 1 + + 8.5-8.5 8.5 1 + 8.5.0-8.5.0 8.5 1 + 8.5a0-8.5.0 8.5 0 +} { + test package-11.$n "package vsatisfies $provided $required" { + package vsatisfies $provided $required + } $satisfied + incr n +} + +test package-12.0 "package vsatisfies multiple" { + # yes no + package vsatisfies 8.4 8.4 7.3 +} 1 +test package-12.1 "package vsatisfies multiple" { + # no yes + package vsatisfies 8.4 7.3 8.4 +} 1 +test package-12.2 "package vsatisfies multiple" { + # yes yes + package vsatisfies 8.4.2 8.4 8.4.1 +} 1 +test package-12.3 "package vsatisfies multiple" { + # no no + package vsatisfies 8.4 7.3 6.1 +} 0 + +proc prefer {args} { + set ip [interp create] + try { + lappend res [$ip eval {package prefer}] + foreach mode $args { + lappend res [$ip eval [list package prefer $mode]] + } + return $res + } finally { + interp delete $ip + } +} + +test package-13.0 {package prefer defaults} { + prefer +} stable +test package-13.1 {package prefer defaults} -body { + set ::env(TCL_PKG_PREFER_LATEST) stable ;# value not relevant! + prefer +} -cleanup { + unset -nocomplain ::env(TCL_PKG_PREFER_LATEST) +} -result latest + +test package-14.0 {wrong\#args} -returnCodes error -body { + package prefer foo bar +} -result {wrong # args: should be "package prefer ?latest|stable?"} +test package-14.1 {bogus argument} -returnCodes error -body { + package prefer foo +} -result {bad preference "foo": must be latest or stable} + +test package-15.0 {set, keep} {package prefer stable} stable +test package-15.1 {set stable, keep} {prefer stable} {stable stable} +test package-15.2 {set latest, change} {prefer latest} {stable latest} +test package-15.3 {set latest, keep} { + prefer latest latest +} {stable latest latest} +test package-15.4 {set stable, rejected} { + prefer latest stable +} {stable latest latest} + +rename prefer {} + +set auto_path $oldPath +package unknown $oldPkgUnknown + +cleanupTests +} + +# cleanup +interp delete $i ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/pkg.test b/tests/pkg.test deleted file mode 100644 index 4f92d4c..0000000 --- a/tests/pkg.test +++ /dev/null @@ -1,1222 +0,0 @@ -# -*- tcl -*- -# Commands covered: pkg -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# -# Copyright (c) 1995-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: pkg.test,v 1.31 2008/07/19 22:50:39 nijtmans Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest 2 - namespace import -force ::tcltest::* -} - -# Do all this in a slave interp to avoid garbaging the -# package list -set i [interp create] -interp eval $i [list set argv $argv] -interp eval $i [list package require tcltest 2] -interp eval $i [list namespace import -force ::tcltest::*] -interp eval $i { - -package forget {*}[package names] -set oldPkgUnknown [package unknown] -package unknown {} -set oldPath $auto_path -set auto_path "" - -test pkg-1.1 {Tcl_PkgProvide procedure} { - package forget t - package provide t 2.3 -} {} -test pkg-1.2 {Tcl_PkgProvide procedure} { - package forget t - package provide t 2.3 - list [catch {package provide t 2.2} msg] $msg -} {1 {conflicting versions provided for package "t": 2.3, then 2.2}} -test pkg-1.3 {Tcl_PkgProvide procedure} { - package forget t - package provide t 2.3 - list [catch {package provide t 2.4} msg] $msg -} {1 {conflicting versions provided for package "t": 2.3, then 2.4}} -test pkg-1.4 {Tcl_PkgProvide procedure} { - package forget t - package provide t 2.3 - list [catch {package provide t 3.3} msg] $msg -} {1 {conflicting versions provided for package "t": 2.3, then 3.3}} -test pkg-1.5 {Tcl_PkgProvide procedure} { - package forget t - package provide t 2.3 - package provide t 2.3 -} {} - -test pkg-1.6 {Tcl_PkgProvide procedure} { - package forget t - package provide t 2.3a1 -} {} - -set n 0 -foreach v { - 2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1 - 2b4a1 2b3b2 -} { - test pkg-1.7.$n {Tcl_PkgProvide procedure} { - package forget t - list [catch {package provide t $v} msg] $msg - } [list 1 "expected version number but got \"$v\""] - incr n -} - -test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} { - package forget t - foreach i {1.4 3.4 2.3 2.4 2.2} { - package ifneeded t $i "set x $i; package provide t $i" - } - set x xxx - package require t - set x -} {3.4} -test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} { - package forget t - foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} { - package ifneeded t $i "set x $i; package provide t $i" - } - set x xxx - package require t - set x -} {3.5} -test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} { - package forget t - foreach i {3.5 2.1 2.3} { - package ifneeded t $i "set x $i; package provide t $i" - } - set x xxx - package require t 2.2 - set x -} {2.3} -test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} { - package forget t - foreach i {1.4 3.4 2.3 2.4 2.2} { - package ifneeded t $i "set x $i; package provide t $i" - } - set x xxx - package require -exact t 2.3 - set x -} {2.3} -test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} { - package forget t - foreach i {1.4 3.4 2.3 2.4 2.2} { - package ifneeded t $i "set x $i; package provide t $i" - } - set x xxx - package require t 2.1 - set x -} {2.4} -test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} { - package forget t - package unknown {} - foreach i {1.4 3.4 2.3 2.4 2.2} { - package ifneeded t $i "set x $i" - } - list [catch {package require t 2.5} msg] $msg -} {1 {can't find package t 2.5}} -test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} { - package forget t - package unknown {} - foreach i {1.4 3.4 2.3 2.4 2.2} { - package ifneeded t $i "set x $i" - } - list [catch {package require t 4.1} msg] $msg -} {1 {can't find package t 4.1}} -test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} { - package forget t - package unknown {} - foreach i {1.4 3.4 2.3 2.4 2.2} { - package ifneeded t $i "set x $i" - } - list [catch {package require -exact t 1.3} msg] $msg -} {1 {can't find package t exactly 1.3}} -test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} { - package forget t - package unknown {} - list [catch {package require t} msg] $msg -} {1 {can't find package t}} -test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body { - package forget t - package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"} - list [catch {package require t 2.1} msg] $msg $::errorInfo -} -match glob -result {1 {ifneeded test} {ifneeded test - while executing -"error "ifneeded test"" - ("package ifneeded*" script) - invoked from within -"package require t 2.1"}} -test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body { - package forget t - package ifneeded t 2.1 "set x invoked" - set x xxx - list [catch {package require t 2.1} msg] $msg $x -} -match glob -result {1 * invoked} -test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} { - package forget t - package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2" - set x xxx - package require t 1.2 - set x -} {1.2} -test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} { - proc pkgUnknown args { - # args = name requirement - # requirement = v-v (for exact version) - global x - set x $args - package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0] - } - package forget t - foreach i {1.4 3.4 2.3 2.4 2.2} { - package ifneeded t $i "set x $i" - } - package unknown pkgUnknown - set x xxx - package require -exact t 1.5 - package unknown {} - set x -} {t 1.5-1.5} -test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} { - proc pkgUnknown args { - package ifneeded t 1.2 "set x loaded; package provide t 1.2" - } - package forget t - package unknown pkgUnknown - set x xxx - set result [list [package require t] $x] - package unknown {} - set result -} {1.2 loaded} -test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} { - proc pkgUnknown args { - global x - set x $args - package provide [lindex $args 0] 2.0 - } - package forget {a b} - package unknown pkgUnknown - set x xxx - package require {a b} - package unknown {} - set x -} {{a b} 0-} -test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} { - proc pkgUnknown args { - error "testing package unknown" - } - package forget t - package unknown pkgUnknown - set result [list [catch {package require t} msg] $msg $::errorInfo] - package unknown {} - set result -} {1 {testing package unknown} {testing package unknown - while executing -"error "testing package unknown"" - (procedure "pkgUnknown" line 2) - invoked from within -"pkgUnknown t 0-" - ("package unknown" script) - invoked from within -"package require t"}} -test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} { - proc pkgUnknown args { - global x - set x $args - } - package forget t - foreach i {1.4 3.4 2.3 2.4 2.2} { - package ifneeded t $i "set x $i" - } - package unknown pkgUnknown - set x xxx - set result [list [catch {package require -exact t 1.5} msg] $msg $x] - package unknown {} - set result -} {1 {can't find package t exactly 1.5} {t 1.5-1.5}} -test pkg-2.18 {Tcl_PkgRequire procedure, version checks} { - package forget t - package provide t 2.3 - package require t -} {2.3} -test pkg-2.19 {Tcl_PkgRequire procedure, version checks} { - package forget t - package provide t 2.3 - package require t 2.1 -} {2.3} -test pkg-2.20 {Tcl_PkgRequire procedure, version checks} { - package forget t - package provide t 2.3 - package require t 2.3 -} {2.3} -test pkg-2.21 {Tcl_PkgRequire procedure, version checks} { - package forget t - package provide t 2.3 - list [catch {package require t 2.4} msg] $msg -} {1 {version conflict for package "t": have 2.3, need 2.4}} -test pkg-2.22 {Tcl_PkgRequire procedure, version checks} { - package forget t - package provide t 2.3 - list [catch {package require t 1.2} msg] $msg -} {1 {version conflict for package "t": have 2.3, need 1.2}} -test pkg-2.23 {Tcl_PkgRequire procedure, version checks} { - package forget t - package provide t 2.3 - package require -exact t 2.3 -} {2.3} -test pkg-2.24 {Tcl_PkgRequire procedure, version checks} { - package forget t - package provide t 2.3 - list [catch {package require -exact t 2.2} msg] $msg -} {1 {version conflict for package "t": have 2.3, need exactly 2.2}} -test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body { - package forget t - package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI} - list [catch {package require t 2.1} msg] $msg $::errorInfo -} -match glob -result {1 {ifneeded test} {EI - ("package ifneeded*" script) - invoked from within -"package require t 2.1"}} -test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body { - package forget t - package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}} - list [catch {package require t 2.1} msg] $msg $::errorInfo -} -match glob -result {1 {ifneeded test} {EI - ("foreach" body line 1) - invoked from within -"foreach x 1 {error "ifneeded test" EI}" - ("package ifneeded*" script) - invoked from within -"package require t 2.1"}} -test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup { - package forget foo -} -body { - package ifneeded foo 1 {package require foo 1} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob -result {circular package dependency:*} -test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup { - package forget foo -} -body { - package ifneeded foo 1 {package require foo 2} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob -result {circular package dependency:*} -test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup { - package forget foo - package forget bar -} -body { - package ifneeded foo 1 {package require bar 1; package provide foo 1} - package ifneeded bar 1 {package require foo 1; package provide bar 1} - package require foo 1 -} -cleanup { - package forget foo - package forget bar -} -returnCodes error -match glob -result {circular package dependency:*} -test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup { - package forget foo - package forget bar -} -body { - package ifneeded foo 1 {package require bar 1; package provide foo 1} - package ifneeded foo 2 {package provide foo 2} - package ifneeded bar 1 {package require foo 2; package provide bar 1} - package require foo 1 -} -cleanup { - package forget foo - package forget bar -} -returnCodes error -match glob -result {circular package dependency:*} -test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {package provide foo 1; error foo} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob -result foo -test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {package provide foo 1; error foo} - catch {package require foo 1} - package provide foo -} -cleanup { - package forget foo -} -result {} -test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {package provide foo 2} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob -result {attempt to provide package * failed:*} -test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {package provide foo 1.1} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob -result {attempt to provide package * failed:*} -test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1.1 {package provide foo 1} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob -result {attempt to provide package * failed:*} -test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1.1 {package provide foo 1} - package require foo 1.1 -} -cleanup { - package forget foo -} -returnCodes error -match glob -result {attempt to provide package * failed:*} -test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob -result {attempt to provide package * failed:*} -test pkg-2.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {break} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob \ --result {attempt to provide package * failed: bad return code:*} -test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {continue} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob \ --result {attempt to provide package * failed: bad return code:*} -test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {return} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob \ --result {attempt to provide package * failed: bad return code:*} -test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo -} -body { - package ifneeded foo 1 {return -level 0 -code 10} - package require foo 1 -} -cleanup { - package forget foo -} -returnCodes error -match glob \ --result {attempt to provide package * failed: bad return code:*} -test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo - set saveUnknown [package unknown] - package unknown {package provide foo 2 ;#} -} -body { - package require foo 1 -} -cleanup { - package forget foo - package unknown $saveUnknown -} -returnCodes error -match glob -result * -test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo - set saveUnknown [package unknown] - package unknown {break ;#} -} -body { - package require foo 1 -} -cleanup { - package forget foo - package unknown $saveUnknown -} -returnCodes error -match glob -result {bad return code:*} -test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo - set saveUnknown [package unknown] - package unknown {continue ;#} -} -body { - package require foo 1 -} -cleanup { - package forget foo - package unknown $saveUnknown -} -returnCodes error -match glob -result {bad return code:*} -test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo - set saveUnknown [package unknown] - package unknown {return ;#} -} -body { - package require foo 1 -} -cleanup { - package forget foo - package unknown $saveUnknown -} -returnCodes error -match glob -result {bad return code:*} -test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup { - package forget foo - set saveUnknown [package unknown] - package unknown {return -level 0 -code 10 ;#} -} -body { - package require foo 1 -} -cleanup { - package forget foo - package unknown $saveUnknown -} -returnCodes error -match glob -result {bad return code:*} -test pkg-2.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup { - package provide demo 1.2.3 -} -body { - package require -exact demo 1.2 -} -cleanup { - package forget demo -} -returnCodes error -result {version conflict for package "demo": have 1.2.3, need exactly 1.2} - - -test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} { - package forget t - foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} { - package ifneeded t $i "set x $i; package provide t $i" - } - set x xxx - package require t - set x -} {3.4} - -test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} { - package forget t - foreach i {1.2b1 1.2 1.3a2 1.3} { - package ifneeded t $i "set x $i; package provide t $i" - } - set x xxx - package require t - set x -} {1.3} - -test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} { - package forget t - foreach i {1.2b1 1.2 1.3 1.3a2} { - package ifneeded t $i "set x $i; package provide t $i" - } - set x xxx - package require t - set x -} {1.3} - - - -test pkg-3.1 {Tcl_PackageCmd procedure} { - list [catch {package} msg] $msg -} {1 {wrong # args: should be "package option ?arg ...?"}} -test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} { - foreach i [package names] { - package forget $i - } - package names -} {} -test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} { - foreach i [package names] { - package forget $i - } - package forget foo -} {} -test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} { - foreach i [package names] { - package forget $i - } - package ifneeded t 1.1 {first script} - package ifneeded t 2.3 {second script} - package ifneeded x 1.4 {x's script} - set result {} - lappend result [lsort [package names]] [package versions t] - package forget t - lappend result [lsort [package names]] [package versions t] -} {{t x} {1.1 2.3} x {}} -test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} { - foreach i [package names] { - package forget $i - } - package ifneeded a 1.1 {first script} - package ifneeded b 2.3 {second script} - package ifneeded c 1.4 {third script} - package forget - set result [list [lsort [package names]]] - package forget a c - lappend result [lsort [package names]] -} {{a b c} b} -test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} { - # Test for Bug 415273 - package ifneeded a 1 "I should have been forgotten" - package forget no-such-package a - set x [package ifneeded a 1] - package forget a - set x -} {} -test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} { - list [catch {package ifneeded a} msg] $msg -} {1 {wrong # args: should be "package ifneeded package version ?script?"}} -test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} { - list [catch {package ifneeded a b c d} msg] $msg -} {1 {wrong # args: should be "package ifneeded package version ?script?"}} -test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} { - list [catch {package ifneeded t xyz} msg] $msg -} {1 {expected version number but got "xyz"}} -test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} { - foreach i [package names] { - package forget $i - } - list [package ifneeded foo 1.1] [package names] -} {{} {}} -test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} { - package forget t - package ifneeded t 1.4 "script for t 1.4" - list [package names] [package ifneeded t 1.4] [package versions t] -} {t {script for t 1.4} 1.4} -test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} { - package forget t - package ifneeded t 1.4 "script for t 1.4" - list [package ifneeded t 1.5] [package names] [package versions t] -} {{} t 1.4} -test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} { - package forget t - package ifneeded t 1.4 "script for t 1.4" - package ifneeded t 1.4 "second script for t 1.4" - list [package ifneeded t 1.4] [package names] [package versions t] -} {{second script for t 1.4} t 1.4} -test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} { - package forget t - package ifneeded t 1.4 "script for t 1.4" - package ifneeded t 1.2 "second script" - package ifneeded t 3.1 "last script" - list [package ifneeded t 1.2] [package versions t] -} {{second script} {1.4 1.2 3.1}} -test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} { - list [catch {package names a} msg] $msg -} {1 {wrong # args: should be "package names"}} -test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} { - foreach i [package names] { - package forget $i - } - package names -} {} -test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} { - foreach i [package names] { - package forget $i - } - package ifneeded x 1.2 {dummy} - package provide x 1.3 - package provide y 2.4 - catch {package require z 47.16} - lsort [package names] -} {x y} -test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} { - list [catch {package provide} msg] $msg -} {1 {wrong # args: should be "package provide package ?version?"}} -test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} { - list [catch {package provide a b c} msg] $msg -} {1 {wrong # args: should be "package provide package ?version?"}} -test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} { - package forget t - package provide t -} {} -test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} { - package forget t - package provide t 2.3 - package provide t -} {2.3} -test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} { - package forget t - list [catch {package provide t a.b} msg] $msg -} {1 {expected version number but got "a.b"}} -test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} { - list [catch {package require} msg] $msg -} {1 {wrong # args: should be "package require ?-exact? package ?requirement ...?"}} - -test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} { - list [catch {package require -exact a b c} msg] $msg - # Exact syntax: -exact name version - # name ?requirement ...? -} {1 {wrong # args: should be "package require ?-exact? package ?requirement ...?"}} - -test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} { - list [catch {package require x a.b} msg] $msg -} {1 {expected version number but got "a.b"}} -test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} { - list [catch {package require -exact x a.b} msg] $msg -} {1 {expected version number but got "a.b"}} -test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} { - list [catch {package require -exact x} msg] $msg -} {1 {wrong # args: should be "package require ?-exact? package ?requirement ...?"}} -test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} { - list [catch {package require -exact} msg] $msg -} {1 {wrong # args: should be "package require ?-exact? package ?requirement ...?"}} -test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} { - package forget t - package provide t 2.3 - package require t 2.1 -} {2.3} -test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} { - package forget t - list [catch {package require t} msg] $msg -} {1 {can't find package t}} -test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} { - package forget t - package ifneeded t 2.3 "error {synthetic error}" - list [catch {package require t 2.3} msg] $msg -} {1 {synthetic error}} -test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} { - list [catch {package unknown a b} msg] $msg -} {1 {wrong # args: should be "package unknown ?command?"}} -test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} { - package unknown "test script" - package unknown -} {test script} -test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} { - package unknown "test script" - package unknown {} - package unknown -} {} -test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} { - list [catch {package vcompare a} msg] $msg -} {1 {wrong # args: should be "package vcompare version1 version2"}} -test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} { - list [catch {package vcompare a b c} msg] $msg -} {1 {wrong # args: should be "package vcompare version1 version2"}} -test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} { - list [catch {package vcompare x.y 3.4} msg] $msg -} {1 {expected version number but got "x.y"}} -test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} { - list [catch {package vcompare 2.1 a.b} msg] $msg -} {1 {expected version number but got "a.b"}} -test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} { - package vc 2.1 2.3 -} {-1} -test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} { - package vc 2.2.4 2.2.4 -} {0} -test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} { - list [catch {package versions} msg] $msg -} {1 {wrong # args: should be "package versions package"}} -test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} { - list [catch {package versions a b} msg] $msg -} {1 {wrong # args: should be "package versions package"}} -test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} { - package forget t - package versions t -} {} -test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} { - package forget t - package provide t 2.3 - package versions t -} {} -test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} { - package forget t - package ifneeded t 2.3 x - package ifneeded t 2.4 y - package versions t -} {2.3 2.4} -test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} { - list [catch {package vsatisfies a} msg] $msg -} {1 {wrong # args: should be "package vsatisfies version ?requirement ...?"}} - -test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} { - list [catch {package vsatisfies x.y 3.4} msg] $msg -} {1 {expected version number but got "x.y"}} -test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} { - list [catch {package vcompare 2.1 a.b} msg] $msg -} {1 {expected version number but got "a.b"}} -test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} { - package vs 2.3 2.1 -} {1} -test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} { - package vs 2.3 1.2 -} {0} -test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} { - list [catch {package foo} msg] $msg -} {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}} - -test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} { - list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg -} {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}} - -test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} { - list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg -} {1 {expected version number but got "x.y"}} - -test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} { - list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg -} {1 {expected version number but got "x.y"}} - - -# No tests for FindPackage; can't think up anything detectable -# errors. - -test pkg-4.1 {TclFreePackageInfo procedure} { - interp create foo - foo eval { - package ifneeded t 2.3 x - package ifneeded t 2.4 y - package ifneeded x 3.1 z - package provide q 4.3 - package unknown "will this get freed?" - } - interp delete foo -} {} -test pkg-4.2 {TclFreePackageInfo procedure} -body { - interp create foo - foo eval { - package ifneeded t 2.3 x - package ifneeded t 2.4 y - package ifneeded x 3.1 z - package provide q 4.3 - } - foo alias z kill - proc kill {} { - interp delete foo - } - foo eval package require x 3.1 -} -returnCodes error -match glob -result * - -test pkg-5.1 {CheckVersion procedure} { - list [catch {package vcompare 1 2.1} msg] $msg -} {0 -1} -test pkg-5.2 {CheckVersion procedure} { - list [catch {package vcompare .1 2.1} msg] $msg -} {1 {expected version number but got ".1"}} -test pkg-5.3 {CheckVersion procedure} { - list [catch {package vcompare 111.2a.3 2.1} msg] $msg -} {1 {expected version number but got "111.2a.3"}} -test pkg-5.4 {CheckVersion procedure} { - list [catch {package vcompare 1.2.3. 2.1} msg] $msg -} {1 {expected version number but got "1.2.3."}} -test pkg-5.5 {CheckVersion procedure} { - list [catch {package vcompare 1.2..3 2.1} msg] $msg -} {1 {expected version number but got "1.2..3"}} - -test pkg-6.1 {ComparePkgVersions procedure} { - package vcompare 1.23 1.22 -} {1} -test pkg-6.2 {ComparePkgVersions procedure} { - package vcompare 1.22.1.2.3 1.22.1.2.3 -} {0} -test pkg-6.3 {ComparePkgVersions procedure} { - package vcompare 1.21 1.22 -} {-1} -test pkg-6.4 {ComparePkgVersions procedure} { - package vcompare 1.21 1.21.2 -} {-1} -test pkg-6.5 {ComparePkgVersions procedure} { - package vcompare 1.21.1 1.21 -} {1} -test pkg-6.6 {ComparePkgVersions procedure} { - package vsatisfies 1.21.1 1.21 -} {1} -test pkg-6.7 {ComparePkgVersions procedure} { - package vsatisfies 2.22.3 1.21 -} {0} -test pkg-6.8 {ComparePkgVersions procedure} { - package vsatisfies 1 1 -} {1} -test pkg-6.9 {ComparePkgVersions procedure} { - package vsatisfies 2 1 -} {0} - -test pkg-7.1 {Tcl_PkgPresent procedure, any version} { - package forget t - package provide t 2.4 - package present t -} {2.4} -test pkg-7.2 {Tcl_PkgPresent procedure, correct version} { - package forget t - package provide t 2.4 - package present t 2.4 -} {2.4} -test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} { - package forget t - package provide t 2.4 - package present t 2.0 -} {2.4} -test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} { - package forget t - package provide t 2.4 - list [catch {package present t 2.6} msg] $msg -} {1 {version conflict for package "t": have 2.4, need 2.6}} -test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} { - package forget t - package provide t 2.4 - list [catch {package present t 1.0} msg] $msg -} {1 {version conflict for package "t": have 2.4, need 1.0}} -test pkg-7.6 {Tcl_PkgPresent procedure, exact version} { - package forget t - package provide t 2.4 - package present -exact t 2.4 -} {2.4} -test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} { - package forget t - package provide t 2.4 - list [catch {package present -exact t 2.3} msg] $msg -} {1 {version conflict for package "t": have 2.4, need exactly 2.3}} -test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} { - package forget t - list [catch {package present t} msg] $msg -} {1 {package t is not present}} -test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} { - package forget t - list [catch {package present t 2.4} msg] $msg -} {1 {package t 2.4 is not present}} -test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} { - package forget t - list [catch {package present -exact t 2.4} msg] $msg -} {1 {package t 2.4 is not present}} -test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} { - list [catch {package present} msg] $msg -} {1 {wrong # args: should be "package present ?-exact? package ?requirement ...?"}} -test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} { - list [catch {package present a b c} msg] $msg -} {1 {expected version number but got "b"}} -test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} { - list [catch {package present -exact a b c} msg] $msg -} {1 {wrong # args: should be "package present ?-exact? package ?requirement ...?"}} -test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} { - list [catch {package present -bs a b} msg] $msg -} {1 {expected version number but got "a"}} -test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} { - list [catch {package present x a.b} msg] $msg -} {1 {expected version number but got "a.b"}} -test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} { - list [catch {package present -exact x a.b} msg] $msg -} {1 {expected version number but got "a.b"}} -test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} { - list [catch {package present -exact x} msg] $msg -} {1 {wrong # args: should be "package present ?-exact? package ?requirement ...?"}} -test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} { - list [catch {package present -exact} msg] $msg -} {1 {wrong # args: should be "package present ?-exact? package ?requirement ...?"}} - - - - -set n 0 -foreach {r p vs vc} { - 8.5a0 8.5a5 1 -1 - 8.5a0 8.5b1 1 -1 - 8.5a0 8.5.1 1 -1 - 8.5a0 8.6a0 1 -1 - 8.5a0 8.6b0 1 -1 - 8.5a0 8.6.0 1 -1 - 8.5a6 8.5a5 0 1 - 8.5a6 8.5b1 1 -1 - 8.5a6 8.5.1 1 -1 - 8.5a6 8.6a0 1 -1 - 8.5a6 8.6b0 1 -1 - 8.5a6 8.6.0 1 -1 - 8.5b0 8.5a5 0 1 - 8.5b0 8.5b1 1 -1 - 8.5b0 8.5.1 1 -1 - 8.5b0 8.6a0 1 -1 - 8.5b0 8.6b0 1 -1 - 8.5b0 8.6.0 1 -1 - 8.5b2 8.5a5 0 1 - 8.5b2 8.5b1 0 1 - 8.5b2 8.5.1 1 -1 - 8.5b2 8.6a0 1 -1 - 8.5b2 8.6b0 1 -1 - 8.5b2 8.6.0 1 -1 - 8.5 8.5a5 1 1 - 8.5 8.5b1 1 1 - 8.5 8.5.1 1 -1 - 8.5 8.6a0 1 -1 - 8.5 8.6b0 1 -1 - 8.5 8.6.0 1 -1 - 8.5.0 8.5a5 0 1 - 8.5.0 8.5b1 0 1 - 8.5.0 8.5.1 1 -1 - 8.5.0 8.6a0 1 -1 - 8.5.0 8.6b0 1 -1 - 8.5.0 8.6.0 1 -1 - 10 8 0 1 - 8 10 0 -1 - 0.0.1.2 0.1.2 1 -1 -} { - test package-vsatisfies-1.$n {package vsatisfies} { - package vsatisfies $p $r - } $vs - - test package-vcompare-1.$n {package vcompare} { - package vcompare $r $p - } $vc - - incr n -} - -test package-vcompare-2.0 {package vcompare at 32bit boundary} { - package vcompare [expr {1<<31}] [expr {(1<<31)-1}] -} 1 - -# Note: It is correct that the result of the very first test, -# i.e. "5.0 5.0a0" is 1, i.e. that version 5.0a0 satisfies a 5.0 -# requirement. - -# The requirement "5.0" internally translates first to "5.0-6", and -# then to its final form of "5.0a0-6a0". These translations are -# explicitly specified by the TIP (Search for "padded/extended -# internally with 'a0'"). This was done intentionally for exactly the -# tested case, that an alpha package can satisfy a requirement for the -# regular package. An example would be a package FOO requiring Tcl 8.X -# for its operation. It can be used with Tcl 8.Xa0. Without our -# translation that would not be possible. - -set n 0 -foreach {required provided satisfied} { - 5.0 5.0a0 1 - 5.0a0 5.0 1 - - 8.5a0- 8.5a5 1 - 8.5a0- 8.5b1 1 - 8.5a0- 8.5.1 1 - 8.5a0- 8.6a0 1 - 8.5a0- 8.6b0 1 - 8.5a0- 8.6.0 1 - 8.5a6- 8.5a5 0 - 8.5a6- 8.5b1 1 - 8.5a6- 8.5.1 1 - 8.5a6- 8.6a0 1 - 8.5a6- 8.6b0 1 - 8.5a6- 8.6.0 1 - 8.5b0- 8.5a5 0 - 8.5b0- 8.5b1 1 - 8.5b0- 8.5.1 1 - 8.5b0- 8.6a0 1 - 8.5b0- 8.6b0 1 - 8.5b0- 8.6.0 1 - 8.5b2- 8.5a5 0 - 8.5b2- 8.5b1 0 - 8.5b2- 8.5.1 1 - 8.5b2- 8.6a0 1 - 8.5b2- 8.6b0 1 - 8.5b2- 8.6.0 1 - 8.5- 8.5a5 1 - 8.5- 8.5b1 1 - 8.5- 8.5.1 1 - 8.5- 8.6a0 1 - 8.5- 8.6b0 1 - 8.5- 8.6.0 1 - 8.5.0- 8.5a5 0 - 8.5.0- 8.5b1 0 - 8.5.0- 8.5.1 1 - 8.5.0- 8.6a0 1 - 8.5.0- 8.6b0 1 - 8.5.0- 8.6.0 1 - 8.5a0-7 8.5a5 0 - 8.5a0-7 8.5b1 0 - 8.5a0-7 8.5.1 0 - 8.5a0-7 8.6a0 0 - 8.5a0-7 8.6b0 0 - 8.5a0-7 8.6.0 0 - 8.5a6-7 8.5a5 0 - 8.5a6-7 8.5b1 0 - 8.5a6-7 8.5.1 0 - 8.5a6-7 8.6a0 0 - 8.5a6-7 8.6b0 0 - 8.5a6-7 8.6.0 0 - 8.5b0-7 8.5a5 0 - 8.5b0-7 8.5b1 0 - 8.5b0-7 8.5.1 0 - 8.5b0-7 8.6a0 0 - 8.5b0-7 8.6b0 0 - 8.5b0-7 8.6.0 0 - 8.5b2-7 8.5a5 0 - 8.5b2-7 8.5b1 0 - 8.5b2-7 8.5.1 0 - 8.5b2-7 8.6a0 0 - 8.5b2-7 8.6b0 0 - 8.5b2-7 8.6.0 0 - 8.5-7 8.5a5 0 - 8.5-7 8.5b1 0 - 8.5-7 8.5.1 0 - 8.5-7 8.6a0 0 - 8.5-7 8.6b0 0 - 8.5-7 8.6.0 0 - 8.5.0-7 8.5a5 0 - 8.5.0-7 8.5b1 0 - 8.5.0-7 8.5.1 0 - 8.5.0-7 8.6a0 0 - 8.5.0-7 8.6b0 0 - 8.5.0-7 8.6.0 0 - 8.5a0-8.6.1 8.5a5 1 - 8.5a0-8.6.1 8.5b1 1 - 8.5a0-8.6.1 8.5.1 1 - 8.5a0-8.6.1 8.6a0 1 - 8.5a0-8.6.1 8.6b0 1 - 8.5a0-8.6.1 8.6.0 1 - 8.5a6-8.6.1 8.5a5 0 - 8.5a6-8.6.1 8.5b1 1 - 8.5a6-8.6.1 8.5.1 1 - 8.5a6-8.6.1 8.6a0 1 - 8.5a6-8.6.1 8.6b0 1 - 8.5a6-8.6.1 8.6.0 1 - 8.5b0-8.6.1 8.5a5 0 - 8.5b0-8.6.1 8.5b1 1 - 8.5b0-8.6.1 8.5.1 1 - 8.5b0-8.6.1 8.6a0 1 - 8.5b0-8.6.1 8.6b0 1 - 8.5b0-8.6.1 8.6.0 1 - 8.5b2-8.6.1 8.5a5 0 - 8.5b2-8.6.1 8.5b1 0 - 8.5b2-8.6.1 8.5.1 1 - 8.5b2-8.6.1 8.6a0 1 - 8.5b2-8.6.1 8.6b0 1 - 8.5b2-8.6.1 8.6.0 1 - 8.5-8.6.1 8.5a5 1 - 8.5-8.6.1 8.5b1 1 - 8.5-8.6.1 8.5.1 1 - 8.5-8.6.1 8.6a0 1 - 8.5-8.6.1 8.6b0 1 - 8.5-8.6.1 8.6.0 1 - 8.5.0-8.6.1 8.5a5 0 - 8.5.0-8.6.1 8.5b1 0 - 8.5.0-8.6.1 8.5.1 1 - 8.5.0-8.6.1 8.6a0 1 - 8.5.0-8.6.1 8.6b0 1 - 8.5.0-8.6.1 8.6.0 1 - 8.5a0-8.5a0 8.5a0 1 - 8.5a0-8.5a0 8.5b1 0 - 8.5a0-8.5a0 8.4 0 - 8.5b0-8.5b0 8.5a5 0 - 8.5b0-8.5b0 8.5b0 1 - 8.5b0-8.5b0 8.5.1 0 - 8.5-8.5 8.5a5 0 - 8.5-8.5 8.5b1 0 - 8.5-8.5 8.5 1 - 8.5-8.5 8.5.1 0 - 8.5.0-8.5.0 8.5a5 0 - 8.5.0-8.5.0 8.5b1 0 - 8.5.0-8.5.0 8.5.0 1 - 8.5.0-8.5.0 8.5.1 0 - 8.5.0-8.5.0 8.6a0 0 - 8.5.0-8.5.0 8.6b0 0 - 8.5.0-8.5.0 8.6.0 0 - 8.2 9 0 - 8.2- 9 1 - 8.2-8.5 9 0 - 8.2-9.1 9 1 - - 8.5-8.5 8.5b1 0 - 8.5a0-8.5 8.5b1 0 - 8.5a0-8.5.1 8.5b1 1 - - 8.5-8.5 8.5 1 - 8.5.0-8.5.0 8.5 1 - 8.5a0-8.5.0 8.5 0 - -} { - test package-vsatisfies-2.$n "package vsatisfies $provided $required" { - package vsatisfies $provided $required - } $satisfied - incr n -} - -test package-vsatisfies-3.0 "package vsatisfies multiple" { - # yes no - package vsatisfies 8.4 8.4 7.3 -} 1 - -test package-vsatisfies-3.1 "package vsatisfies multiple" { - # no yes - package vsatisfies 8.4 7.3 8.4 -} 1 - -test package-vsatisfies-3.2 "package vsatisfies multiple" { - # yes yes - package vsatisfies 8.4.2 8.4 8.4.1 -} 1 - -test package-vsatisfies-3.3 "package vsatisfies multiple" { - # no no - package vsatisfies 8.4 7.3 6.1 -} 0 - - -proc prefer {args} { - set ip [interp create] - lappend res [$ip eval {package prefer}] - foreach mode $args { - lappend res [$ip eval [list package prefer $mode]] - } - interp delete $ip - return $res -} - -test package-prefer-1.0 {default} { - prefer -} stable - -test package-prefer-1.1 {default} { - set ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant! - set res [prefer] - unset ::env(TCL_PKG_PREFER_LATEST) - set res -} latest - -test package-prefer-2.0 {wrong\#args} { - catch {package prefer foo bar} msg - set msg -} {wrong # args: should be "package prefer ?latest|stable?"} - -test package-prefer-2.1 {bogus argument} { - catch {package prefer foo} msg - set msg -} {bad preference "foo": must be latest or stable} - -test package-prefer-3.0 {set, keep} { - package prefer stable -} stable - -test package-prefer-3.1 {set stable, keep} { - prefer stable -} {stable stable} - -test package-prefer-3.2 {set latest, change} { - prefer latest -} {stable latest} - -test package-prefer-3.3 {set latest, keep} { - prefer latest latest -} {stable latest latest} - -test package-prefer-3.4 {set stable, rejected} { - prefer latest stable -} {stable latest latest} - -rename prefer {} - - -set auto_path $oldPath -package unknown $oldPkgUnknown -concat - -cleanupTests -} - -# cleanup -interp delete $i -::tcltest::cleanupTests -return diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 0db6533..33c76d5 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -2,13 +2,13 @@ # Note that the tests are limited to Tcl scripts only, there are no shared # libraries against which to test. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: pkgMkIndex.test,v 1.29 2006/11/03 00:34:53 hobbs Exp $ +# RCS: @(#) $Id: pkgMkIndex.test,v 1.30 2011/01/06 10:20:39 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -17,7 +17,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { set fullPkgPath [makeDirectory pkg] - namespace eval pkgtest { # Namespace for procs we can discard } @@ -27,8 +26,8 @@ namespace eval pkgtest { # Parse an argument list. # # Arguments: -# <flags> (optional) arguments starting with a dash are collected -# as options to pkg_mkIndex and passed to pkg_mkIndex. +# <flags> (optional) arguments starting with a dash are collected as +# options to pkg_mkIndex and passed to pkg_mkIndex. # dirPath the directory to index # pattern0 pattern to index # ... pattern to index @@ -130,13 +129,13 @@ proc pkgtest::parseIndex { filePath } { # pkgtest::createIndex -- # -# Runs pkg_mkIndex for the given directory and set of patterns. -# This procedure deletes any pkgIndex.tcl file in the target directory, -# then runs pkg_mkIndex. +# Runs pkg_mkIndex for the given directory and set of patterns. This +# procedure deletes any pkgIndex.tcl file in the target directory, then runs +# pkg_mkIndex. # # Arguments: -# <flags> (optional) arguments starting with a dash are collected -# as options to pkg_mkIndex and passed to pkg_mkIndex. +# <flags> (optional) arguments starting with a dash are collected as +# options to pkg_mkIndex and passed to pkg_mkIndex. # dirPath the directory to index # pattern0 pattern to index # ... pattern to index @@ -194,11 +193,9 @@ proc makePkgList { inList } { lappend l $s } } - source { set l $v } - default { error "can't handle $k $v" } @@ -215,8 +212,8 @@ proc makePkgList { inList } { # Runs pkg_mkIndex, parses the generated index file. # # Arguments: -# <flags> (optional) arguments starting with a dash are collected -# as options to pkg_mkIndex and passed to pkg_mkIndex. +# <flags> (optional) arguments starting with a dash are collected as +# options to pkg_mkIndex and passed to pkg_mkIndex. # dirPath the directory to index # pattern0 pattern to index # ... pattern to index @@ -226,8 +223,7 @@ proc makePkgList { inList } { # Returns a two element list: # 0: 1 if the procedure encountered an error, 0 otherwise. # 1: if no error, this is the parsed generated index file, in the format -# returned by pkgtest::parseIndex. -# If error, this is the error result. +# returned by pkgtest::parseIndex. If error, this is the error result. proc pkgtest::runCreatedIndex {rv args} { if {[lindex $rv 0] == 0} { @@ -251,9 +247,9 @@ proc pkgtest::runIndex { args } { set rv [createIndex {*}$args] return [runCreatedIndex $rv {*}$args] } - -# If there is no match to the patterns, make sure the directory hasn't -# changed on us + +# If there is no match to the patterns, make sure the directory hasn't changed +# on us test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} { list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd] @@ -314,8 +310,8 @@ removeFile [file join pkg global.tcl] makeFile { # This package is required by pkg1. -# This package is split into two files, to test packages that are split -# over multiple files. +# This package is split into two files, to test packages that are split over +# multiple files. package provide pkg2 1.0 namespace eval pkg2 { namespace export p2-1 @@ -327,8 +323,8 @@ proc pkg2::p2-1 { num } { makeFile { # This package is required by pkg1. -# This package is split into two files, to test packages that are split -# over multiple files. +# This package is split into two files, to test packages that are split over +# multiple files. package provide pkg2 1.0 namespace eval pkg2 { namespace export p2-2 @@ -347,8 +343,8 @@ test pkgMkIndex-4.2 {split package - direct loading} { } "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]] [list source [file join $fullPkgPath pkg2_b.tcl]]}}}" -# Add the direct1 directory to auto_path, so that the direct1 package -# can be found. +# Add the direct1 directory to auto_path, so that the direct1 package can be +# found. set direct1 [makeDirectory direct1] lappend auto_path $direct1 makeFile { @@ -367,9 +363,9 @@ proc direct1::pd2 { stg } { pkg_mkIndex -direct $direct1 direct1.tcl makeFile { -# Does a package require of direct1, whose pkgIndex.tcl entry -# is created above with option -direct. This tests that pkg_mkIndex -# can handle code that is sourced in pkgIndex.tcl files. +# Does a package require of direct1, whose pkgIndex.tcl entry is created +# above with option -direct. This tests that pkg_mkIndex can handle code +# that is sourced in pkgIndex.tcl files. package require direct1 package provide std 1.0 namespace eval std { @@ -393,9 +389,9 @@ removeDirectory direct1 removeFile [file join pkg std.tcl] makeFile { -# This package requires pkg3, but it does -# not use any of pkg3's procs in the code that is executed by the file -# (i.e. references to pkg3's procs are in the proc bodies only). +# This package requires pkg3, but it does not use any of pkg3's procs in the +# code that is executed by the file (i.e. references to pkg3's procs are in +# the proc bodies only). package require pkg3 1.0 package provide pkg1 1.0 namespace eval pkg1 { @@ -433,8 +429,8 @@ test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} { removeFile [file join pkg pkg1.tcl] makeFile { -# This package requires pkg3, and it calls -# a pkg3 proc in the code that is executed by the file +# This package requires pkg3, and it calls a pkg3 proc in the code that is +# executed by the file package require pkg3 1.0 package provide pkg4 1.0 namespace eval pkg4 { @@ -462,9 +458,8 @@ removeFile [file join pkg pkg4.tcl] removeFile [file join pkg pkg3.tcl] makeFile { -# This package requires pkg2, and it calls -# a pkg2 proc in the code that is executed by the file. -# Pkg2 is a split package. +# This package requires pkg2, and it calls a pkg2 proc in the code that is +# executed by the file. Pkg2 is a split package. package require pkg2 1.0 package provide pkg5 1.0 namespace eval pkg5 { @@ -496,9 +491,9 @@ removeFile [file join pkg pkg2_a.tcl] removeFile [file join pkg pkg2_b.tcl] makeFile { -# This package requires circ2, and circ2 -# requires circ3, which in turn requires circ1. -# In case of cirularities, pkg_mkIndex should give up when it gets stuck. +# This package requires circ2, and circ2 requires circ3, which in turn +# requires circ1. In case of cirularities, pkg_mkIndex should give up when +# it gets stuck. package require circ2 1.0 package provide circ1 1.0 namespace eval circ1 { @@ -519,8 +514,8 @@ proc circ1::c1-4 {} { } [file join pkg circ1.tcl] makeFile { -# This package is required by circ1, and -# requires circ3. Circ3, in turn, requires circ1 to give us a circularity. +# This package is required by circ1, and requires circ3. Circ3, in turn, +# requires circ1 to give us a circularity. package require circ3 1.0 package provide circ2 1.0 namespace eval circ2 { @@ -535,8 +530,8 @@ proc circ2::c2-2 { num } { } [file join pkg circ2.tcl] makeFile { -# This package is required by circ2, and in -# turn requires circ1. This closes the circularity. +# This package is required by circ2, and in turn requires circ1. This closes +# the circularity. package require circ1 1.0 package provide circ3 1.0 namespace eval circ3 { @@ -577,22 +572,23 @@ proc pkga_neq { x } { testConstraint exec [llength [info commands ::exec]] test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] { - # Do all [load]ing of shared libraries in another process, so - # we can delete the file and not get stuck because we're holding - # a reference to it. + # Do all [load]ing of shared libraries in another process, so we can + # delete the file and not get stuck because we're holding a reference to + # it. set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl] exec [interpreter] << $cmd pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl } "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}" test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] { - # Do all [load]ing of shared libraries in another process, so - # we can delete the file and not get stuck because we're holding - # a reference to it. + # Do all [load]ing of shared libraries in another process, so we can + # delete the file and not get stuck because we're holding a reference to + # it. # # This test depends on context from prior test, so repeat it. - set script "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]\n" - append script \ - "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]" + set script \ + "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]" + append script \n \ + "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]" exec [interpreter] << $script pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension] } {0 {}} @@ -625,9 +621,8 @@ test pkgMkIndex-11.1 {conflicting namespace imports} { removeFile [file join pkg import.tcl] -# Verify that the auto load list generated is correct even when there -# is a proc name conflict between two namespaces (ie, ::foo::baz and -# ::bar::baz) +# Verify that the auto load list generated is correct even when there is a +# proc name conflict between two namespaces (ie, ::foo::baz and ::bar::baz) makeFile { package provide football 1.0 @@ -692,7 +687,7 @@ test pkgMkIndex-14.5 {tcl::Pkg::CompareExtension} {unix} { test pkgMkIndex-14.6 {tcl::Pkg::CompareExtension} {unix} { tcl::Pkg::CompareExtension foo.so.1.2.bar .so } 0 - + # cleanup removeDirectory pkg @@ -701,3 +696,7 @@ namespace delete pkgtest ::tcltest::cleanupTests return +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/proc.test b/tests/proc.test index 789c671..ba0c20d 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -1,40 +1,36 @@ -# This file contains tests for the tclProc.c source file. Tests appear in -# the same order as the C code that they test. The set of tests is -# currently incomplete since it includes only new tests, in particular -# tests for code changed for the addition of Tcl namespaces. Other -# procedure-related tests appear in other test files such as proc-old.test. +# This file contains tests for the tclProc.c source file. Tests appear in the +# same order as the C code that they test. The set of tests is currently +# incomplete since it includes only new tests, in particular tests for code +# changed for the addition of Tcl namespaces. Other procedure-related tests +# appear in other test files such as proc-old.test. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: proc.test,v 1.21 2009/10/29 17:21:48 dgp Exp $ +# RCS: @(#) $Id: proc.test,v 1.22 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest +if {"::tcltest" ni [namespace children]} { + package require tcltest 2 namespace import -force ::tcltest::* } -if {[catch {package require procbodytest}]} { - testConstraint procbodytest 0 -} else { - testConstraint procbodytest 1 -} - -testConstraint memory [llength [info commands memory]] +testConstraint procbodytest [expr {![catch {package require procbodytest}]}] +testConstraint memory [llength [info commands memory]] catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} catch {rename {} ""} catch {unset msg} - -test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} { + +test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { namespace eval test_ns_1 { namespace eval baz {} } @@ -44,23 +40,26 @@ test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} list [test_ns_1::baz::p] \ [namespace eval test_ns_1 {baz::p}] \ [info commands test_ns_1::baz::*] -} {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p} -test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} { +} -result {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p} +test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} - list [catch {proc test_ns_1::baz::p {} {}} msg] $msg -} {1 {can't create procedure "test_ns_1::baz::p": unknown namespace}} -test proc-1.3 {Tcl_ProcObjCmd, empty proc name} { +} -returnCodes error -body { + proc test_ns_1::baz::p {} {} +} -result {can't create procedure "test_ns_1::baz::p": unknown namespace} +test proc-1.3 {Tcl_ProcObjCmd, empty proc name} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { proc :: {} { return "empty called" } list [::] \ [info body {}] -} {{empty called} { +} -result {{empty called} { return "empty called" }} -test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} { +test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { namespace eval test_ns_1 { namespace eval baz { proc p {} { @@ -70,9 +69,10 @@ test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} { } list [test_ns_1::baz::p] \ [info commands test_ns_1::baz::*] -} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p} -test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} { +} -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p} +test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { namespace eval test_ns_1::baz {} namespace eval test_ns_1 { proc baz::p {} { @@ -82,9 +82,10 @@ test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace list [test_ns_1::baz::p] \ [info commands test_ns_1::baz::*] \ [namespace eval test_ns_1::baz {namespace which p}] -} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p} -test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} { +} -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p} +test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { namespace eval test_ns_1 { proc q: {} {return "q:"} proc value:at: {} {return "value:at:"} @@ -96,88 +97,97 @@ test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or e [lsort [info commands test_ns_1::*]] \ [namespace eval test_ns_1 {namespace which q:}] \ [namespace eval test_ns_1 {namespace which value:at:}] -} {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:} -test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} { +} -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:} +test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup { catch {rename p ""} - list [catch {proc p {a(1) a(2)} { - set z [expr $a(1)+$a(2)] - puts "$z=z, $a(1)=$a(1)" - }} msg] $msg -} {1 {formal parameter "a(1)" is an array element}} -test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} { +} -returnCodes error -body { + proc p {a(1) a(2)} { + set z [expr $a(1)+$a(2)] + puts "$z=z, $a(1)=$a(1)" + } +} -result {formal parameter "a(1)" is an array element} +test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup { catch {rename p ""} - list [catch {proc p {b:a b::a} { - }} msg] $msg -} {1 {formal parameter "b::a" is not a simple name}} +} -body { + proc p {b:a b::a} { + } +} -returnCodes error -result {formal parameter "b::a" is not a simple name} -test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} { +test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} +} -body { proc p {} {return "p in [namespace current]"} info body p -} {return "p in [namespace current]"} -test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} { +} -result {return "p in [namespace current]"} +test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { namespace eval test_ns_1 { namespace eval baz { proc p {} {return "p in [namespace current]"} } } namespace eval test_ns_1::baz {info body p} -} {return "p in [namespace current]"} -test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} { +} -result {return "p in [namespace current]"} +test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { namespace eval test_ns_1::baz {} namespace eval test_ns_1 { proc baz::p {} {return "p in [namespace current]"} } namespace eval test_ns_1 {info body baz::p} -} {return "p in [namespace current]"} -test proc-2.4 {TclFindProc, global proc and executing in namespace} { +} -result {return "p in [namespace current]"} +test proc-2.4 {TclFindProc, global proc and executing in namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} +} -body { proc p {} {return "global p"} namespace eval test_ns_1::baz {info body p} -} {return "global p"} +} -result {return "global p"} -test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} { +test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { proc p {} {return "p in [namespace current]"} p -} {p in ::} -test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} { +} -result {p in ::} +test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} +} -body { namespace eval test_ns_1::baz { proc p {} {return "p in [namespace current]"} p } -} {p in ::test_ns_1::baz} -test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} { +} -result {p in ::test_ns_1::baz} +test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} +} -body { proc p {} {return "p in [namespace current]"} namespace eval test_ns_1::baz { p } -} {p in ::} -test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} { +} -result {p in ::} +test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} -setup { catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} +} -body { namespace eval test_ns_1::baz { proc p {} {return "p in [namespace current]"} rename ::test_ns_1::baz::p ::p list [p] [namespace which p] } -} {{p in ::} ::p} -test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} { +} -result {{p in ::} ::p} +test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} -body { proc p {x} {info commands 3m} - list [catch {p} msg] $msg -} {1 {wrong # args: should be "p x"}} - -test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} { + p +} -returnCodes error -result {wrong # args: should be "p x"} +test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} -body { proc {a b c} {x} {info commands 3m} - list [catch {{a b c}} msg] $msg -} {1 {wrong # args: should be "{a b c} x"}} + {a b c} +} -returnCodes error -result {wrong # args: should be "{a b c} x"} catch {namespace delete {*}[namespace children :: test_ns_*]} catch {rename p ""} @@ -189,116 +199,95 @@ catch {rename p ""} catch {rename t ""} # Note that the test require that procedures whose body is used to create -# procbody objects must be executed before the procbodytest::proc command -# is executed, so that the Proc struct is populated correctly (CompiledLocals -# are added at compile time). +# procbody objects must be executed before the procbodytest::proc command is +# executed, so that the Proc struct is populated correctly (CompiledLocals are +# added at compile time). -test proc-4.1 {TclCreateProc, procbody obj} procbodytest { - catch { - proc p x {return "$x:$x"} - set rv [p P] - procbodytest::proc t x p - lappend rv [t T] - set rv - } result +test proc-4.1 {TclCreateProc, procbody obj} -constraints procbodytest -body { + proc p x {return "$x:$x"} + set rv [p P] + procbodytest::proc t x p + lappend rv [t T] +} -cleanup { catch {rename p ""} catch {rename t ""} - set result -} {P:P T:T} -test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} procbodytest { - catch { - proc p x { - set y [string tolower $x] - return "$x:$y" - } - set rv [p P] - procbodytest::proc t x p - lappend rv [t T] - set rv - } result +} -result {P:P T:T} +test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} -body { + proc p x { + set y [string tolower $x] + return "$x:$y" + } + set rv [p P] + procbodytest::proc t x p + lappend rv [t T] +} -constraints procbodytest -cleanup { catch {rename p ""} catch {rename t ""} - set result -} {P:p T:t} -test proc-4.3 {TclCreateProc, procbody obj, too many args} procbodytest { - catch { - proc p x { - set y [string tolower $x] - return "$x:$y" - } - set rv [p P] - procbodytest::proc t {x x1 x2} p - lappend rv [t T] - set rv - } result +} -result {P:p T:t} +test proc-4.3 {TclCreateProc, procbody obj, too many args} -body { + proc p x { + set y [string tolower $x] + return "$x:$y" + } + set rv [p P] + procbodytest::proc t {x x1 x2} p + lappend rv [t T] +} -constraints procbodytest -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} - set result -} {procedure "t": arg list contains 3 entries, precompiled header expects 1} -test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} procbodytest { - catch { - proc p {x y z} { - set v [join [list $x $y $z]] - set w [string tolower $v] - return "$v:$w" - } - set rv [p P Q R] - procbodytest::proc t {x x1 z} p - lappend rv [t S T U] - set rv - } result +} -result {procedure "t": arg list contains 3 entries, precompiled header expects 1} +test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} -body { + proc p {x y z} { + set v [join [list $x $y $z]] + set w [string tolower $v] + return "$v:$w" + } + set rv [p P Q R] + procbodytest::proc t {x x1 z} p + lappend rv [t S T U] +} -constraints procbodytest -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} - set result -} {procedure "t": formal parameter 1 is inconsistent with precompiled body} -test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} procbodytest { - catch { - proc p {x y {z Z}} { - set v [join [list $x $y $z]] - set w [string tolower $v] - return "$v:$w" - } - set rv [p P Q R] - procbodytest::proc t {x y z} p - lappend rv [t S T U] - set rv - } result +} -result {procedure "t": formal parameter 1 is inconsistent with precompiled body} +test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} -body { + proc p {x y {z Z}} { + set v [join [list $x $y $z]] + set w [string tolower $v] + return "$v:$w" + } + set rv [p P Q R] + procbodytest::proc t {x y z} p + lappend rv [t S T U] +} -constraints procbodytest -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} - set result -} {procedure "t": formal parameter 2 is inconsistent with precompiled body} -test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} procbodytest { - catch { - proc p {x y z} { - set v [join [list $x $y $z]] - set w [string tolower $v] - return "$v:$w" - } - set rv [p P Q R] - procbodytest::proc t {x y {z Z}} p - lappend rv [t S T U] - set rv - } result +} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body} +test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} -body { + proc p {x y z} { + set v [join [list $x $y $z]] + set w [string tolower $v] + return "$v:$w" + } + set rv [p P Q R] + procbodytest::proc t {x y {z Z}} p + lappend rv [t S T U] +} -returnCodes error -constraints procbodytest -cleanup { catch {rename p ""} catch {rename t ""} - set result -} {procedure "t": formal parameter 2 is inconsistent with precompiled body} -test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} procbodytest { - catch { - proc p {x y {z Z}} { - set v [join [list $x $y $z]] - set w [string tolower $v] - return "$v:$w" - } - set rv [p P Q R] - procbodytest::proc t {x y {z ZZ}} p - lappend rv [t S T U] - set rv - } result +} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body} +test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} -body { + proc p {x y {z Z}} { + set v [join [list $x $y $z]] + set w [string tolower $v] + return "$v:$w" + } + set rv [p P Q R] + procbodytest::proc t {x y {z ZZ}} p + lappend rv [t S T U] +} -constraints procbodytest -returnCodes error -cleanup { catch {rename p ""} catch {rename t ""} - set result -} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body} +} -result {procedure "t": formal parameter "z" has default value inconsistent with precompiled body} test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -setup { proc getbytes {} { set lines [split [memory info] "\n"] @@ -310,12 +299,9 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set } px x } -constraints {procbodytest memory} -body { - set end [getbytes] for {set i 0} {$i < 5} {incr i} { - procbodytest::proc tx x px - set tmp $end set end [getbytes] } @@ -325,7 +311,7 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set unset -nocomplain end i tmp leakedBytes } -result 0 -test proc-5.1 {Bytecompiling noop; test for correct argument substitution} { +test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body { proc p args {} ; # this will be bytecompiled into t proc t {} { set res {} @@ -336,20 +322,20 @@ test proc-5.1 {Bytecompiling noop; test for correct argument substitution} { p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello set res } - set result [t] + t +} -cleanup { catch {rename p ""} catch {rename t ""} - set result -} {aba} +} -result {aba} -test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} { +test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} -body { proc a {} {return -code -5} proc b {} a - set result [catch b] + catch b +} -cleanup { rename a {} rename b {} - set result -} -5 +} -result -5 test proc-7.1 {Redefining a compiled cmd: Bug 729692} { proc bar args {} @@ -359,19 +345,17 @@ test proc-7.1 {Redefining a compiled cmd: Bug 729692} { } foo } bar - -test proc-7.2 {Shadowing a compiled cmd: Bug 729692} { +test proc-7.2 {Shadowing a compiled cmd: Bug 729692} -body { namespace eval ugly {} proc ugly::foo {} { proc set args {return bar} set x 1 } - set res [list [catch {ugly::foo} msg] $msg] + ugly::foo +} -cleanup { namespace delete ugly - set res -} {0 bar} - -test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} { +} -result bar +test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body { namespace eval ugly {} proc ugly::foo {} { set i 0 @@ -383,15 +367,18 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} { } return $i } - set res [list [catch {ugly::foo} msg] $msg] + ugly::foo +} -cleanup { namespace delete ugly - set res -} {0 4} - - - +} -result 4 + # cleanup catch {rename p ""} catch {rename t ""} ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/remote.tcl b/tests/remote.tcl index de827de..06000aa 100644 --- a/tests/remote.tcl +++ b/tests/remote.tcl @@ -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: remote.tcl,v 1.3.56.2 2010/12/01 16:42:37 kennykb Exp $ +# RCS: @(#) $Id: remote.tcl,v 1.5 2010/11/04 21:38:27 rmax Exp $ # Initialize message delimitor diff --git a/tests/safe.test b/tests/safe.test index 51d2f7e..5025469 100644 --- a/tests/safe.test +++ b/tests/safe.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: safe.test,v 1.34.2.2 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: safe.test,v 1.36 2010/12/07 16:32:06 dkf Exp $ package require Tcl 8.5 diff --git a/tests/security.test b/tests/security.test index 2549a4a..e92775e 100644 --- a/tests/security.test +++ b/tests/security.test @@ -1,18 +1,18 @@ # security.test -- # -# Functionality covered: this file contains a collection of tests for the -# auto loading and namespaces. +# Functionality covered: this file contains a collection of tests for the auto +# loading and namespaces. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: security.test,v 1.6 2004/05/19 13:02:10 dkf Exp $ +# RCS: @(#) $Id: security.test,v 1.7 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest namespace import -force ::tcltest::* } @@ -41,3 +41,7 @@ test security-1.1 {tcl_endOfPreviousWord} { # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/socket.test b/tests/socket.test index e263c57..1cc4441 100644 --- a/tests/socket.test +++ b/tests/socket.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: socket.test,v 1.43.2.2 2010/12/01 16:42:37 kennykb Exp $ +# RCS: @(#) $Id: socket.test,v 1.49 2010/11/04 21:38:27 rmax Exp $ # Running socket tests with a remote server: # ------------------------------------------ diff --git a/tests/stringComp.test b/tests/stringComp.test index 35c11d1..6ef94ee 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringComp.test,v 1.17.4.1 2010/09/25 14:51:13 kennykb Exp $ +# RCS: @(#) $Id: stringComp.test,v 1.18 2010/09/25 02:25:54 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest diff --git a/tests/subst.test b/tests/subst.test index 9af2609..0c81069 100644 --- a/tests/subst.test +++ b/tests/subst.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: subst.test,v 1.20.2.1 2010/10/09 17:53:17 kennykb Exp $ +# RCS: @(#) $Id: subst.test,v 1.21 2010/10/06 18:38:45 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 diff --git a/tests/switch.test b/tests/switch.test index 738565f..3f127a4 100644 --- a/tests/switch.test +++ b/tests/switch.test @@ -11,13 +11,13 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: switch.test,v 1.25 2009/07/14 16:52:28 kennykb Exp $ +# RCS: @(#) $Id: switch.test,v 1.26 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* } - + test switch-1.1 {simple patterns} { switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4} } 1 @@ -753,7 +753,7 @@ test switch-15.1 {coroutine safety of non-bytecoded switch} {*}{ rename coro {} } } - + # cleanup catch {rename foo {}} ::tcltest::cleanupTests diff --git a/tests/unixInit.test b/tests/unixInit.test index 1f4dc7a..1f5c7c1 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -1,23 +1,23 @@ # The file tests the functions in the tclUnixInit.c file. # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1997 by Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixInit.test,v 1.50 2006/11/03 11:45:35 dkf Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.51 2011/01/01 15:14:43 dkf Exp $ package require tcltest 2.2 namespace import -force ::tcltest::* unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C - + test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { set x {} # Watch out for a race condition here. If tcltest is too slow to start @@ -36,13 +36,13 @@ test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { lappend x [catch {close $f}] set x } {0 1} -# This test is really a test of code in tclUnixChan.c, but the -# channels are set up as part of initialisation of the interpreter so -# the test seems to me to fit here as well as anywhere else. +# This test is really a test of code in tclUnixChan.c, but the channels are +# set up as part of initialisation of the interpreter so the test seems to me +# to fit here as well as anywhere else. test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} { - # pipe1 is a connection to a server that reports what port it - # starts on, and delivers a constant string to the first client to - # connect to that port before exiting. + # pipe1 is a connection to a server that reports what port it starts on, + # and delivers a constant string to the first client to connect to that + # port before exiting. set pipe1 [open "|[list [interpreter]]" r+] puts $pipe1 { proc accept {channel host port} { @@ -53,16 +53,16 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} puts [fconfigure [socket -server accept -myaddr 127.0.0.1 0] -sockname] vwait forever \ } - # Note the backslash above; this is important to make sure that the - # whole string is read before an [exit] can happen... + # Note the backslash above; this is important to make sure that the whole + # string is read before an [exit] can happen... flush $pipe1 set port [lindex [gets $pipe1] 2] set sock [socket localhost $port] - # pipe2 is a connection to a Tcl interpreter that takes its orders - # from the socket we hand it (i.e. the server we create above.) - # These orders will tell it to print out the details about the - # socket it is taking instructions from, hopefully identifying it - # as a socket. Which is what this test is all about. + # pipe2 is a connection to a Tcl interpreter that takes its orders from + # the socket we hand it (i.e. the server we create above.) These orders + # will tell it to print out the details about the socket it is taking + # instructions from, hopefully identifying it as a socket. Which is what + # this test is all about. set pipe2 [open "|[list [interpreter] <@$sock]" r] set result [gets $pipe2] # Clear any pending data; stops certain kinds of (non-important) errors @@ -85,8 +85,8 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} } {OK} # The unixInit-2.* tests were written to test the internal routine, -# TclpInitLibraryPath. That routine no longer does the things it used -# to do so those tests are obsolete. Skip them. +# TclpInitLibraryPath. That routine no longer does the things it used to do +# so those tests are obsolete. Skip them. skip [concat [skip] unixInit-2.*] @@ -207,10 +207,9 @@ test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} { # [lindex $auto_path end] } {} # -# The following two tests write to the directory /tmp/sparkly instead -# of to [temporaryDirectory]. This is because the failures tested by -# these tests need paths near the "root" of the file system to present -# themselves. +# The following two tests write to the directory /tmp/sparkly instead of to +# [temporaryDirectory]. This is because the failures tested by these tests +# need paths near the "root" of the file system to present themselves. # test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup { unset -nocomplain oldlibrary @@ -219,20 +218,20 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup { } set env(TCL_LIBRARY) [info library] # Checking for Bug 219416 - # When a program that embeds the Tcl library, like tcltest, is - # installed near the "root" of the file system, there was a problem - # constructing directories relative to the executable. When a - # relative ".." went past the root, relative path names were created - # rather than absolute pathnames. In some cases, accessing past the - # root caused memory access violations too. + # When a program that embeds the Tcl library, like tcltest, is installed + # near the "root" of the file system, there was a problem constructing + # directories relative to the executable. When a relative ".." went past + # the root, relative path names were created rather than absolute + # pathnames. In some cases, accessing past the root caused memory access + # violations too. # - # The bug is now fixed, but here we check for it by making sure that - # the directories constructed relative to the executable are all - # absolute pathnames, even when the executable is installed near - # the root of the filesystem. + # The bug is now fixed, but here we check for it by making sure that the + # directories constructed relative to the executable are all absolute + # pathnames, even when the executable is installed near the root of the + # filesystem. # - # The only directory near the root we are likely to have write access - # to is /tmp. + # The only directory near the root we are likely to have write access to + # is /tmp. file delete -force /tmp/sparkly file delete -force /tmp/lib/tcl[info tclversion] file mkdir /tmp/sparkly @@ -367,12 +366,11 @@ test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} { catch {set env(LC_ALL) $oldlc_all} set validEncodings [list euc-jp] if {[string match HP-UX $tcl_platform(os)]} { - # Some older HP-UX systems need us to accept this as valid - # Bug 453883 reports that newer HP-UX systems report euc-jp - # like everybody else. + # Some older HP-UX systems need us to accept this as valid Bug 453883 + # reports that newer HP-UX systems report euc-jp like everybody else. lappend validEncodings shiftjis } - expr {[lsearch -exact $validEncodings $enc] < 0} + expr {$enc ni $validEncodings} } 0 test unixInit-4.1 {TclpSetVariables} {unix} { @@ -403,7 +401,7 @@ test unixInit-7.1 {closed standard channel: Bug 772288} -constraints { removeFile crash.tcl removeFile crashtest.tcl } -returnCodes 0 - + # cleanup catch {unset env(LANG)} catch {set env(LANG) $oldlang} @@ -411,3 +409,7 @@ unset -nocomplain path ::tcltest::cleanupTests return +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/tests/uplevel.test b/tests/uplevel.test index 2f725bc..264edbe 100644 --- a/tests/uplevel.test +++ b/tests/uplevel.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: uplevel.test,v 1.9.6.1 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: uplevel.test,v 1.10 2010/12/07 16:32:06 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -26,7 +26,7 @@ proc newset {name value} { uplevel set $name $value uplevel 1 {uplevel 1 {set xyz 22}} } - + test uplevel-1.1 {simple operation} { set xyz 0 a 22 33 @@ -197,7 +197,7 @@ test uplevel-7.3 {var access, LVT in upper level} -setup { rename foo {} rename moo {} } -result {3 3 3} - + # cleanup ::tcltest::cleanupTests return diff --git a/tests/upvar.test b/tests/upvar.test index d181043..90ba0b1 100644 --- a/tests/upvar.test +++ b/tests/upvar.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: upvar.test,v 1.20.4.1 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: upvar.test,v 1.21 2010/12/07 16:32:06 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 diff --git a/tests/utf.test b/tests/utf.test index f2dfb8f..3a45d13 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.14.10.1 2010/10/20 01:50:19 kennykb Exp $ +# RCS: @(#) $Id: utf.test,v 1.15 2010/10/18 21:47:36 nijtmans Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 diff --git a/tests/util.test b/tests/util.test index bfb8507..b16fa28 100644 --- a/tests/util.test +++ b/tests/util.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: util.test,v 1.20.6.1 2010/12/01 16:42:37 kennykb Exp $ +# RCS: @(#) $Id: util.test,v 1.23 2011/01/15 18:10:19 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1903,10 +1903,1969 @@ test util-14.2 {funky NaN} {*}{ -result -NaN(3456789abcdef) } +test util-15.1 {largest subnormal} {*}{ + -body { + binary scan [binary format w 0x000fffffffffffff] q x + set x + } + -result 2.225073858507201e-308 + -cleanup { + unset x + } +} + +test util-15.2 {largest subnormal} {*}{ + -body { + binary scan [binary format w 0x800fffffffffffff] q x + set x + } + -result -2.225073858507201e-308 + -cleanup { + unset x + } +} + +test util-15.3 {largest subnormal} {*}{ + -body { + binary scan [binary format q 2.225073858507201e-308] w x + format %#lx $x + } + -result 0xfffffffffffff + -cleanup { + unset x + } +} + +test util-15.4 {largest subnormal} {*}{ + -body { + binary scan [binary format q -2.225073858507201e-308] w x + format %#lx $x + } + -result 0x800fffffffffffff + -cleanup { + unset x + } +} + +test util-15.5 {smallest normal} {*}{ + -body { + binary scan [binary format w 0x0010000000000000] q x + set x + } + -result 2.2250738585072014e-308 + -cleanup { + unset x + } +} + +test util-15.6 {smallest normal} {*}{ + -body { + binary scan [binary format w 0x8010000000000000] q x + set x + } + -result -2.2250738585072014e-308 + -cleanup { + unset x + } +} + +test util-15.7 {smallest normal} {*}{ + -body { + binary scan [binary format q 2.2250738585072014e-308] w x + format %#lx $x + } + -result 0x10000000000000 + -cleanup { + unset x + } +} + +test util-15.8 {smallest normal} {*}{ + -body { + binary scan [binary format q -2.2250738585072014e-308] w x + format %#lx $x + } + -result 0x8010000000000000 + -cleanup { + unset x + } +} + +set saved_precision $::tcl_precision +foreach ::tcl_precision {0 12} { + for {set e -312} {$e < -9} {incr e} { + test util-16.1.$::tcl_precision.$e {shortening of numbers} \ + "expr 1.1e$e" 1.1e$e + } +} +set tcl_precision 0 +for {set e -9} {$e < -4} {incr e} { + test util-16.1.$::tcl_precision.$e {shortening of numbers} \ + "expr 1.1e$e" 1.1e$e +} +set tcl_precision 12 +for {set e -9} {$e < -4} {incr e} { + test util-16.1.$::tcl_precision.$e {8.4 compatible formatting of doubles} \ + "expr 1.1e$e" 1.1e[format %+03d $e] +} +foreach ::tcl_precision {0 12} { + test util-16.1.$::tcl_precision.-4 {shortening of numbers} \ + {expr 1.1e-4} \ + 0.00011 + test util-16.1.$::tcl_precision.-3 {shortening of numbers} \ + {expr 1.1e-3} \ + 0.0011 + test util-16.1.$::tcl_precision.-2 {shortening of numbers} \ + {expr 1.1e-2} \ + 0.011 + test util-16.1.$::tcl_precision.-1 {shortening of numbers} \ + {expr 1.1e-1} \ + 0.11 + test util-16.1.$::tcl_precision.0 {shortening of numbers} \ + {expr 1.1} \ + 1.1 + for {set e 1} {$e < 17} {incr e} { + test util-16.1.$::tcl_precision.$e {shortening of numbers} \ + "expr 11[string repeat 0 [expr {$e-1}]].0" \ + 11[string repeat 0 [expr {$e-1}]].0 + } + for {set e 17} {$e < 309} {incr e} { + test util-16.1.$::tcl_precision.$e {shortening of numbers} \ + "expr 1.1e$e" 1.1e+$e + } +} +set tcl_precision 17 +test util-16.1.17.-300 {8.4 compatible formatting of doubles} \ + {expr 1e-300} \ + 1e-300 +test util-16.1.17.-299 {8.4 compatible formatting of doubles} \ + {expr 1e-299} \ + 9.9999999999999999e-300 +test util-16.1.17.-298 {8.4 compatible formatting of doubles} \ + {expr 1e-298} \ + 9.9999999999999991e-299 +test util-16.1.17.-297 {8.4 compatible formatting of doubles} \ + {expr 1e-297} \ + 1e-297 +test util-16.1.17.-296 {8.4 compatible formatting of doubles} \ + {expr 1e-296} \ + 1e-296 +test util-16.1.17.-295 {8.4 compatible formatting of doubles} \ + {expr 1e-295} \ + 1.0000000000000001e-295 +test util-16.1.17.-294 {8.4 compatible formatting of doubles} \ + {expr 1e-294} \ + 1e-294 +test util-16.1.17.-293 {8.4 compatible formatting of doubles} \ + {expr 1e-293} \ + 1.0000000000000001e-293 +test util-16.1.17.-292 {8.4 compatible formatting of doubles} \ + {expr 1e-292} \ + 1.0000000000000001e-292 +test util-16.1.17.-291 {8.4 compatible formatting of doubles} \ + {expr 1e-291} \ + 9.9999999999999996e-292 +test util-16.1.17.-290 {8.4 compatible formatting of doubles} \ + {expr 1e-290} \ + 1.0000000000000001e-290 +test util-16.1.17.-289 {8.4 compatible formatting of doubles} \ + {expr 1e-289} \ + 1e-289 +test util-16.1.17.-288 {8.4 compatible formatting of doubles} \ + {expr 1e-288} \ + 1.0000000000000001e-288 +test util-16.1.17.-287 {8.4 compatible formatting of doubles} \ + {expr 1e-287} \ + 1e-287 +test util-16.1.17.-286 {8.4 compatible formatting of doubles} \ + {expr 1e-286} \ + 1.0000000000000001e-286 +test util-16.1.17.-285 {8.4 compatible formatting of doubles} \ + {expr 1e-285} \ + 1.0000000000000001e-285 +test util-16.1.17.-284 {8.4 compatible formatting of doubles} \ + {expr 1e-284} \ + 1e-284 +test util-16.1.17.-283 {8.4 compatible formatting of doubles} \ + {expr 1e-283} \ + 9.9999999999999995e-284 +test util-16.1.17.-282 {8.4 compatible formatting of doubles} \ + {expr 1e-282} \ + 1e-282 +test util-16.1.17.-281 {8.4 compatible formatting of doubles} \ + {expr 1e-281} \ + 1e-281 +test util-16.1.17.-280 {8.4 compatible formatting of doubles} \ + {expr 1e-280} \ + 9.9999999999999996e-281 +test util-16.1.17.-279 {8.4 compatible formatting of doubles} \ + {expr 1e-279} \ + 1.0000000000000001e-279 +test util-16.1.17.-278 {8.4 compatible formatting of doubles} \ + {expr 1e-278} \ + 9.9999999999999994e-279 +test util-16.1.17.-277 {8.4 compatible formatting of doubles} \ + {expr 1e-277} \ + 9.9999999999999997e-278 +test util-16.1.17.-276 {8.4 compatible formatting of doubles} \ + {expr 1e-276} \ + 1.0000000000000001e-276 +test util-16.1.17.-275 {8.4 compatible formatting of doubles} \ + {expr 1e-275} \ + 9.9999999999999993e-276 +test util-16.1.17.-274 {8.4 compatible formatting of doubles} \ + {expr 1e-274} \ + 9.9999999999999997e-275 +test util-16.1.17.-273 {8.4 compatible formatting of doubles} \ + {expr 1e-273} \ + 1.0000000000000001e-273 +test util-16.1.17.-272 {8.4 compatible formatting of doubles} \ + {expr 1e-272} \ + 9.9999999999999993e-273 +test util-16.1.17.-271 {8.4 compatible formatting of doubles} \ + {expr 1e-271} \ + 9.9999999999999996e-272 +test util-16.1.17.-270 {8.4 compatible formatting of doubles} \ + {expr 1e-270} \ + 1e-270 +test util-16.1.17.-269 {8.4 compatible formatting of doubles} \ + {expr 1e-269} \ + 9.9999999999999996e-270 +test util-16.1.17.-268 {8.4 compatible formatting of doubles} \ + {expr 1e-268} \ + 9.9999999999999996e-269 +test util-16.1.17.-267 {8.4 compatible formatting of doubles} \ + {expr 1e-267} \ + 9.9999999999999998e-268 +test util-16.1.17.-266 {8.4 compatible formatting of doubles} \ + {expr 1e-266} \ + 9.9999999999999998e-267 +test util-16.1.17.-265 {8.4 compatible formatting of doubles} \ + {expr 1e-265} \ + 9.9999999999999998e-266 +test util-16.1.17.-264 {8.4 compatible formatting of doubles} \ + {expr 1e-264} \ + 1e-264 +test util-16.1.17.-263 {8.4 compatible formatting of doubles} \ + {expr 1e-263} \ + 1e-263 +test util-16.1.17.-262 {8.4 compatible formatting of doubles} \ + {expr 1e-262} \ + 1e-262 +test util-16.1.17.-261 {8.4 compatible formatting of doubles} \ + {expr 1e-261} \ + 9.9999999999999998e-262 +test util-16.1.17.-260 {8.4 compatible formatting of doubles} \ + {expr 1e-260} \ + 9.9999999999999996e-261 +test util-16.1.17.-259 {8.4 compatible formatting of doubles} \ + {expr 1e-259} \ + 1.0000000000000001e-259 +test util-16.1.17.-258 {8.4 compatible formatting of doubles} \ + {expr 1e-258} \ + 9.9999999999999995e-259 +test util-16.1.17.-257 {8.4 compatible formatting of doubles} \ + {expr 1e-257} \ + 9.9999999999999998e-258 +test util-16.1.17.-256 {8.4 compatible formatting of doubles} \ + {expr 1e-256} \ + 9.9999999999999998e-257 +test util-16.1.17.-255 {8.4 compatible formatting of doubles} \ + {expr 1e-255} \ + 1e-255 +test util-16.1.17.-254 {8.4 compatible formatting of doubles} \ + {expr 1e-254} \ + 9.9999999999999991e-255 +test util-16.1.17.-253 {8.4 compatible formatting of doubles} \ + {expr 1e-253} \ + 1.0000000000000001e-253 +test util-16.1.17.-252 {8.4 compatible formatting of doubles} \ + {expr 1e-252} \ + 9.9999999999999994e-253 +test util-16.1.17.-251 {8.4 compatible formatting of doubles} \ + {expr 1e-251} \ + 1e-251 +test util-16.1.17.-250 {8.4 compatible formatting of doubles} \ + {expr 1e-250} \ + 1.0000000000000001e-250 +test util-16.1.17.-249 {8.4 compatible formatting of doubles} \ + {expr 1e-249} \ + 1.0000000000000001e-249 +test util-16.1.17.-248 {8.4 compatible formatting of doubles} \ + {expr 1e-248} \ + 9.9999999999999998e-249 +test util-16.1.17.-247 {8.4 compatible formatting of doubles} \ + {expr 1e-247} \ + 1e-247 +test util-16.1.17.-246 {8.4 compatible formatting of doubles} \ + {expr 1e-246} \ + 9.9999999999999996e-247 +test util-16.1.17.-245 {8.4 compatible formatting of doubles} \ + {expr 1e-245} \ + 9.9999999999999993e-246 +test util-16.1.17.-244 {8.4 compatible formatting of doubles} \ + {expr 1e-244} \ + 9.9999999999999993e-245 +test util-16.1.17.-243 {8.4 compatible formatting of doubles} \ + {expr 1e-243} \ + 1e-243 +test util-16.1.17.-242 {8.4 compatible formatting of doubles} \ + {expr 1e-242} \ + 9.9999999999999997e-243 +test util-16.1.17.-241 {8.4 compatible formatting of doubles} \ + {expr 1e-241} \ + 9.9999999999999997e-242 +test util-16.1.17.-240 {8.4 compatible formatting of doubles} \ + {expr 1e-240} \ + 9.9999999999999997e-241 +test util-16.1.17.-239 {8.4 compatible formatting of doubles} \ + {expr 1e-239} \ + 1.0000000000000001e-239 +test util-16.1.17.-238 {8.4 compatible formatting of doubles} \ + {expr 1e-238} \ + 9.9999999999999999e-239 +test util-16.1.17.-237 {8.4 compatible formatting of doubles} \ + {expr 1e-237} \ + 9.9999999999999999e-238 +test util-16.1.17.-236 {8.4 compatible formatting of doubles} \ + {expr 1e-236} \ + 1e-236 +test util-16.1.17.-235 {8.4 compatible formatting of doubles} \ + {expr 1e-235} \ + 9.9999999999999996e-236 +test util-16.1.17.-234 {8.4 compatible formatting of doubles} \ + {expr 1e-234} \ + 9.9999999999999996e-235 +test util-16.1.17.-233 {8.4 compatible formatting of doubles} \ + {expr 1e-233} \ + 9.9999999999999996e-234 +test util-16.1.17.-232 {8.4 compatible formatting of doubles} \ + {expr 1e-232} \ + 1e-232 +test util-16.1.17.-231 {8.4 compatible formatting of doubles} \ + {expr 1e-231} \ + 9.9999999999999999e-232 +test util-16.1.17.-230 {8.4 compatible formatting of doubles} \ + {expr 1e-230} \ + 1e-230 +test util-16.1.17.-229 {8.4 compatible formatting of doubles} \ + {expr 1e-229} \ + 1.0000000000000001e-229 +test util-16.1.17.-228 {8.4 compatible formatting of doubles} \ + {expr 1e-228} \ + 1e-228 +test util-16.1.17.-227 {8.4 compatible formatting of doubles} \ + {expr 1e-227} \ + 9.9999999999999994e-228 +test util-16.1.17.-226 {8.4 compatible formatting of doubles} \ + {expr 1e-226} \ + 9.9999999999999992e-227 +test util-16.1.17.-225 {8.4 compatible formatting of doubles} \ + {expr 1e-225} \ + 9.9999999999999996e-226 +test util-16.1.17.-224 {8.4 compatible formatting of doubles} \ + {expr 1e-224} \ + 1e-224 +test util-16.1.17.-223 {8.4 compatible formatting of doubles} \ + {expr 1e-223} \ + 9.9999999999999997e-224 +test util-16.1.17.-222 {8.4 compatible formatting of doubles} \ + {expr 1e-222} \ + 1e-222 +test util-16.1.17.-221 {8.4 compatible formatting of doubles} \ + {expr 1e-221} \ + 1e-221 +test util-16.1.17.-220 {8.4 compatible formatting of doubles} \ + {expr 1e-220} \ + 9.9999999999999999e-221 +test util-16.1.17.-219 {8.4 compatible formatting of doubles} \ + {expr 1e-219} \ + 1e-219 +test util-16.1.17.-218 {8.4 compatible formatting of doubles} \ + {expr 1e-218} \ + 1e-218 +test util-16.1.17.-217 {8.4 compatible formatting of doubles} \ + {expr 1e-217} \ + 1.0000000000000001e-217 +test util-16.1.17.-216 {8.4 compatible formatting of doubles} \ + {expr 1e-216} \ + 1e-216 +test util-16.1.17.-215 {8.4 compatible formatting of doubles} \ + {expr 1e-215} \ + 1e-215 +test util-16.1.17.-214 {8.4 compatible formatting of doubles} \ + {expr 1e-214} \ + 9.9999999999999991e-215 +test util-16.1.17.-213 {8.4 compatible formatting of doubles} \ + {expr 1e-213} \ + 9.9999999999999995e-214 +test util-16.1.17.-212 {8.4 compatible formatting of doubles} \ + {expr 1e-212} \ + 9.9999999999999995e-213 +test util-16.1.17.-211 {8.4 compatible formatting of doubles} \ + {expr 1e-211} \ + 1.0000000000000001e-211 +test util-16.1.17.-210 {8.4 compatible formatting of doubles} \ + {expr 1e-210} \ + 1e-210 +test util-16.1.17.-209 {8.4 compatible formatting of doubles} \ + {expr 1e-209} \ + 1e-209 +test util-16.1.17.-208 {8.4 compatible formatting of doubles} \ + {expr 1e-208} \ + 1.0000000000000001e-208 +test util-16.1.17.-207 {8.4 compatible formatting of doubles} \ + {expr 1e-207} \ + 9.9999999999999993e-208 +test util-16.1.17.-206 {8.4 compatible formatting of doubles} \ + {expr 1e-206} \ + 1e-206 +test util-16.1.17.-205 {8.4 compatible formatting of doubles} \ + {expr 1e-205} \ + 1e-205 +test util-16.1.17.-204 {8.4 compatible formatting of doubles} \ + {expr 1e-204} \ + 1e-204 +test util-16.1.17.-203 {8.4 compatible formatting of doubles} \ + {expr 1e-203} \ + 1e-203 +test util-16.1.17.-202 {8.4 compatible formatting of doubles} \ + {expr 1e-202} \ + 1e-202 +test util-16.1.17.-201 {8.4 compatible formatting of doubles} \ + {expr 1e-201} \ + 9.9999999999999995e-202 +test util-16.1.17.-200 {8.4 compatible formatting of doubles} \ + {expr 1e-200} \ + 9.9999999999999998e-201 +test util-16.1.17.-199 {8.4 compatible formatting of doubles} \ + {expr 1e-199} \ + 9.9999999999999998e-200 +test util-16.1.17.-198 {8.4 compatible formatting of doubles} \ + {expr 1e-198} \ + 9.9999999999999991e-199 +test util-16.1.17.-197 {8.4 compatible formatting of doubles} \ + {expr 1e-197} \ + 9.9999999999999999e-198 +test util-16.1.17.-196 {8.4 compatible formatting of doubles} \ + {expr 1e-196} \ + 1e-196 +test util-16.1.17.-195 {8.4 compatible formatting of doubles} \ + {expr 1e-195} \ + 1.0000000000000001e-195 +test util-16.1.17.-194 {8.4 compatible formatting of doubles} \ + {expr 1e-194} \ + 1e-194 +test util-16.1.17.-193 {8.4 compatible formatting of doubles} \ + {expr 1e-193} \ + 1e-193 +test util-16.1.17.-192 {8.4 compatible formatting of doubles} \ + {expr 1e-192} \ + 1.0000000000000001e-192 +test util-16.1.17.-191 {8.4 compatible formatting of doubles} \ + {expr 1e-191} \ + 1e-191 +test util-16.1.17.-190 {8.4 compatible formatting of doubles} \ + {expr 1e-190} \ + 1e-190 +test util-16.1.17.-189 {8.4 compatible formatting of doubles} \ + {expr 1e-189} \ + 1.0000000000000001e-189 +test util-16.1.17.-188 {8.4 compatible formatting of doubles} \ + {expr 1e-188} \ + 9.9999999999999995e-189 +test util-16.1.17.-187 {8.4 compatible formatting of doubles} \ + {expr 1e-187} \ + 1e-187 +test util-16.1.17.-186 {8.4 compatible formatting of doubles} \ + {expr 1e-186} \ + 9.9999999999999991e-187 +test util-16.1.17.-185 {8.4 compatible formatting of doubles} \ + {expr 1e-185} \ + 9.9999999999999999e-186 +test util-16.1.17.-184 {8.4 compatible formatting of doubles} \ + {expr 1e-184} \ + 1.0000000000000001e-184 +test util-16.1.17.-183 {8.4 compatible formatting of doubles} \ + {expr 1e-183} \ + 1e-183 +test util-16.1.17.-182 {8.4 compatible formatting of doubles} \ + {expr 1e-182} \ + 1e-182 +test util-16.1.17.-181 {8.4 compatible formatting of doubles} \ + {expr 1e-181} \ + 1e-181 +test util-16.1.17.-180 {8.4 compatible formatting of doubles} \ + {expr 1e-180} \ + 1e-180 +test util-16.1.17.-179 {8.4 compatible formatting of doubles} \ + {expr 1e-179} \ + 1e-179 +test util-16.1.17.-178 {8.4 compatible formatting of doubles} \ + {expr 1e-178} \ + 9.9999999999999995e-179 +test util-16.1.17.-177 {8.4 compatible formatting of doubles} \ + {expr 1e-177} \ + 9.9999999999999995e-178 +test util-16.1.17.-176 {8.4 compatible formatting of doubles} \ + {expr 1e-176} \ + 1e-176 +test util-16.1.17.-175 {8.4 compatible formatting of doubles} \ + {expr 1e-175} \ + 1e-175 +test util-16.1.17.-174 {8.4 compatible formatting of doubles} \ + {expr 1e-174} \ + 1e-174 +test util-16.1.17.-173 {8.4 compatible formatting of doubles} \ + {expr 1e-173} \ + 1e-173 +test util-16.1.17.-172 {8.4 compatible formatting of doubles} \ + {expr 1e-172} \ + 1e-172 +test util-16.1.17.-171 {8.4 compatible formatting of doubles} \ + {expr 1e-171} \ + 9.9999999999999998e-172 +test util-16.1.17.-170 {8.4 compatible formatting of doubles} \ + {expr 1e-170} \ + 9.9999999999999998e-171 +test util-16.1.17.-169 {8.4 compatible formatting of doubles} \ + {expr 1e-169} \ + 1e-169 +test util-16.1.17.-168 {8.4 compatible formatting of doubles} \ + {expr 1e-168} \ + 1e-168 +test util-16.1.17.-167 {8.4 compatible formatting of doubles} \ + {expr 1e-167} \ + 1e-167 +test util-16.1.17.-166 {8.4 compatible formatting of doubles} \ + {expr 1e-166} \ + 1e-166 +test util-16.1.17.-165 {8.4 compatible formatting of doubles} \ + {expr 1e-165} \ + 1e-165 +test util-16.1.17.-164 {8.4 compatible formatting of doubles} \ + {expr 1e-164} \ + 9.9999999999999996e-165 +test util-16.1.17.-163 {8.4 compatible formatting of doubles} \ + {expr 1e-163} \ + 9.9999999999999992e-164 +test util-16.1.17.-162 {8.4 compatible formatting of doubles} \ + {expr 1e-162} \ + 9.9999999999999995e-163 +test util-16.1.17.-161 {8.4 compatible formatting of doubles} \ + {expr 1e-161} \ + 1e-161 +test util-16.1.17.-160 {8.4 compatible formatting of doubles} \ + {expr 1e-160} \ + 9.9999999999999999e-161 +test util-16.1.17.-159 {8.4 compatible formatting of doubles} \ + {expr 1e-159} \ + 9.9999999999999999e-160 +test util-16.1.17.-158 {8.4 compatible formatting of doubles} \ + {expr 1e-158} \ + 1.0000000000000001e-158 +test util-16.1.17.-157 {8.4 compatible formatting of doubles} \ + {expr 1e-157} \ + 9.9999999999999994e-158 +test util-16.1.17.-156 {8.4 compatible formatting of doubles} \ + {expr 1e-156} \ + 1e-156 +test util-16.1.17.-155 {8.4 compatible formatting of doubles} \ + {expr 1e-155} \ + 1e-155 +test util-16.1.17.-154 {8.4 compatible formatting of doubles} \ + {expr 1e-154} \ + 9.9999999999999997e-155 +test util-16.1.17.-153 {8.4 compatible formatting of doubles} \ + {expr 1e-153} \ + 1e-153 +test util-16.1.17.-152 {8.4 compatible formatting of doubles} \ + {expr 1e-152} \ + 1.0000000000000001e-152 +test util-16.1.17.-151 {8.4 compatible formatting of doubles} \ + {expr 1e-151} \ + 9.9999999999999994e-152 +test util-16.1.17.-150 {8.4 compatible formatting of doubles} \ + {expr 1e-150} \ + 1e-150 +test util-16.1.17.-149 {8.4 compatible formatting of doubles} \ + {expr 1e-149} \ + 9.9999999999999998e-150 +test util-16.1.17.-148 {8.4 compatible formatting of doubles} \ + {expr 1e-148} \ + 9.9999999999999994e-149 +test util-16.1.17.-147 {8.4 compatible formatting of doubles} \ + {expr 1e-147} \ + 9.9999999999999997e-148 +test util-16.1.17.-146 {8.4 compatible formatting of doubles} \ + {expr 1e-146} \ + 1e-146 +test util-16.1.17.-145 {8.4 compatible formatting of doubles} \ + {expr 1e-145} \ + 9.9999999999999991e-146 +test util-16.1.17.-144 {8.4 compatible formatting of doubles} \ + {expr 1e-144} \ + 9.9999999999999995e-145 +test util-16.1.17.-143 {8.4 compatible formatting of doubles} \ + {expr 1e-143} \ + 9.9999999999999995e-144 +test util-16.1.17.-142 {8.4 compatible formatting of doubles} \ + {expr 1e-142} \ + 1e-142 +test util-16.1.17.-141 {8.4 compatible formatting of doubles} \ + {expr 1e-141} \ + 1e-141 +test util-16.1.17.-140 {8.4 compatible formatting of doubles} \ + {expr 1e-140} \ + 9.9999999999999998e-141 +test util-16.1.17.-139 {8.4 compatible formatting of doubles} \ + {expr 1e-139} \ + 1e-139 +test util-16.1.17.-138 {8.4 compatible formatting of doubles} \ + {expr 1e-138} \ + 1.0000000000000001e-138 +test util-16.1.17.-137 {8.4 compatible formatting of doubles} \ + {expr 1e-137} \ + 9.9999999999999998e-138 +test util-16.1.17.-136 {8.4 compatible formatting of doubles} \ + {expr 1e-136} \ + 1e-136 +test util-16.1.17.-135 {8.4 compatible formatting of doubles} \ + {expr 1e-135} \ + 1e-135 +test util-16.1.17.-134 {8.4 compatible formatting of doubles} \ + {expr 1e-134} \ + 1e-134 +test util-16.1.17.-133 {8.4 compatible formatting of doubles} \ + {expr 1e-133} \ + 1.0000000000000001e-133 +test util-16.1.17.-132 {8.4 compatible formatting of doubles} \ + {expr 1e-132} \ + 9.9999999999999999e-133 +test util-16.1.17.-131 {8.4 compatible formatting of doubles} \ + {expr 1e-131} \ + 9.9999999999999999e-132 +test util-16.1.17.-130 {8.4 compatible formatting of doubles} \ + {expr 1e-130} \ + 1.0000000000000001e-130 +test util-16.1.17.-129 {8.4 compatible formatting of doubles} \ + {expr 1e-129} \ + 9.9999999999999993e-130 +test util-16.1.17.-128 {8.4 compatible formatting of doubles} \ + {expr 1e-128} \ + 1.0000000000000001e-128 +test util-16.1.17.-127 {8.4 compatible formatting of doubles} \ + {expr 1e-127} \ + 1e-127 +test util-16.1.17.-126 {8.4 compatible formatting of doubles} \ + {expr 1e-126} \ + 9.9999999999999995e-127 +test util-16.1.17.-125 {8.4 compatible formatting of doubles} \ + {expr 1e-125} \ + 1e-125 +test util-16.1.17.-124 {8.4 compatible formatting of doubles} \ + {expr 1e-124} \ + 9.9999999999999993e-125 +test util-16.1.17.-123 {8.4 compatible formatting of doubles} \ + {expr 1e-123} \ + 1.0000000000000001e-123 +test util-16.1.17.-122 {8.4 compatible formatting of doubles} \ + {expr 1e-122} \ + 1.0000000000000001e-122 +test util-16.1.17.-121 {8.4 compatible formatting of doubles} \ + {expr 1e-121} \ + 9.9999999999999998e-122 +test util-16.1.17.-120 {8.4 compatible formatting of doubles} \ + {expr 1e-120} \ + 9.9999999999999998e-121 +test util-16.1.17.-119 {8.4 compatible formatting of doubles} \ + {expr 1e-119} \ + 1e-119 +test util-16.1.17.-118 {8.4 compatible formatting of doubles} \ + {expr 1e-118} \ + 9.9999999999999999e-119 +test util-16.1.17.-117 {8.4 compatible formatting of doubles} \ + {expr 1e-117} \ + 1e-117 +test util-16.1.17.-116 {8.4 compatible formatting of doubles} \ + {expr 1e-116} \ + 9.9999999999999999e-117 +test util-16.1.17.-115 {8.4 compatible formatting of doubles} \ + {expr 1e-115} \ + 1.0000000000000001e-115 +test util-16.1.17.-114 {8.4 compatible formatting of doubles} \ + {expr 1e-114} \ + 1.0000000000000001e-114 +test util-16.1.17.-113 {8.4 compatible formatting of doubles} \ + {expr 1e-113} \ + 9.9999999999999998e-114 +test util-16.1.17.-112 {8.4 compatible formatting of doubles} \ + {expr 1e-112} \ + 9.9999999999999995e-113 +test util-16.1.17.-111 {8.4 compatible formatting of doubles} \ + {expr 1e-111} \ + 1.0000000000000001e-111 +test util-16.1.17.-110 {8.4 compatible formatting of doubles} \ + {expr 1e-110} \ + 1.0000000000000001e-110 +test util-16.1.17.-109 {8.4 compatible formatting of doubles} \ + {expr 1e-109} \ + 9.9999999999999999e-110 +test util-16.1.17.-108 {8.4 compatible formatting of doubles} \ + {expr 1e-108} \ + 1e-108 +test util-16.1.17.-107 {8.4 compatible formatting of doubles} \ + {expr 1e-107} \ + 1e-107 +test util-16.1.17.-106 {8.4 compatible formatting of doubles} \ + {expr 1e-106} \ + 9.9999999999999994e-107 +test util-16.1.17.-105 {8.4 compatible formatting of doubles} \ + {expr 1e-105} \ + 9.9999999999999997e-106 +test util-16.1.17.-104 {8.4 compatible formatting of doubles} \ + {expr 1e-104} \ + 9.9999999999999993e-105 +test util-16.1.17.-103 {8.4 compatible formatting of doubles} \ + {expr 1e-103} \ + 9.9999999999999996e-104 +test util-16.1.17.-102 {8.4 compatible formatting of doubles} \ + {expr 1e-102} \ + 9.9999999999999993e-103 +test util-16.1.17.-101 {8.4 compatible formatting of doubles} \ + {expr 1e-101} \ + 1.0000000000000001e-101 +test util-16.1.17.-100 {8.4 compatible formatting of doubles} \ + {expr 1e-100} \ + 1e-100 +test util-16.1.17.-99 {8.4 compatible formatting of doubles} \ + {expr 1e-99} \ + 1e-99 +test util-16.1.17.-98 {8.4 compatible formatting of doubles} \ + {expr 1e-98} \ + 9.9999999999999994e-99 +test util-16.1.17.-97 {8.4 compatible formatting of doubles} \ + {expr 1e-97} \ + 1e-97 +test util-16.1.17.-96 {8.4 compatible formatting of doubles} \ + {expr 1e-96} \ + 9.9999999999999991e-97 +test util-16.1.17.-95 {8.4 compatible formatting of doubles} \ + {expr 1e-95} \ + 9.9999999999999999e-96 +test util-16.1.17.-94 {8.4 compatible formatting of doubles} \ + {expr 1e-94} \ + 9.9999999999999996e-95 +test util-16.1.17.-93 {8.4 compatible formatting of doubles} \ + {expr 1e-93} \ + 9.999999999999999e-94 +test util-16.1.17.-92 {8.4 compatible formatting of doubles} \ + {expr 1e-92} \ + 9.9999999999999999e-93 +test util-16.1.17.-91 {8.4 compatible formatting of doubles} \ + {expr 1e-91} \ + 1e-91 +test util-16.1.17.-90 {8.4 compatible formatting of doubles} \ + {expr 1e-90} \ + 9.9999999999999999e-91 +test util-16.1.17.-89 {8.4 compatible formatting of doubles} \ + {expr 1e-89} \ + 1e-89 +test util-16.1.17.-88 {8.4 compatible formatting of doubles} \ + {expr 1e-88} \ + 9.9999999999999993e-89 +test util-16.1.17.-87 {8.4 compatible formatting of doubles} \ + {expr 1e-87} \ + 1e-87 +test util-16.1.17.-86 {8.4 compatible formatting of doubles} \ + {expr 1e-86} \ + 1.0000000000000001e-86 +test util-16.1.17.-85 {8.4 compatible formatting of doubles} \ + {expr 1e-85} \ + 9.9999999999999998e-86 +test util-16.1.17.-84 {8.4 compatible formatting of doubles} \ + {expr 1e-84} \ + 1e-84 +test util-16.1.17.-83 {8.4 compatible formatting of doubles} \ + {expr 1e-83} \ + 1e-83 +test util-16.1.17.-82 {8.4 compatible formatting of doubles} \ + {expr 1e-82} \ + 9.9999999999999996e-83 +test util-16.1.17.-81 {8.4 compatible formatting of doubles} \ + {expr 1e-81} \ + 9.9999999999999996e-82 +test util-16.1.17.-80 {8.4 compatible formatting of doubles} \ + {expr 1e-80} \ + 9.9999999999999996e-81 +test util-16.1.17.-79 {8.4 compatible formatting of doubles} \ + {expr 1e-79} \ + 1e-79 +test util-16.1.17.-78 {8.4 compatible formatting of doubles} \ + {expr 1e-78} \ + 1e-78 +test util-16.1.17.-77 {8.4 compatible formatting of doubles} \ + {expr 1e-77} \ + 9.9999999999999993e-78 +test util-16.1.17.-76 {8.4 compatible formatting of doubles} \ + {expr 1e-76} \ + 9.9999999999999993e-77 +test util-16.1.17.-75 {8.4 compatible formatting of doubles} \ + {expr 1e-75} \ + 9.9999999999999996e-76 +test util-16.1.17.-74 {8.4 compatible formatting of doubles} \ + {expr 1e-74} \ + 9.9999999999999996e-75 +test util-16.1.17.-73 {8.4 compatible formatting of doubles} \ + {expr 1e-73} \ + 1e-73 +test util-16.1.17.-72 {8.4 compatible formatting of doubles} \ + {expr 1e-72} \ + 9.9999999999999997e-73 +test util-16.1.17.-71 {8.4 compatible formatting of doubles} \ + {expr 1e-71} \ + 9.9999999999999992e-72 +test util-16.1.17.-70 {8.4 compatible formatting of doubles} \ + {expr 1e-70} \ + 1e-70 +test util-16.1.17.-69 {8.4 compatible formatting of doubles} \ + {expr 1e-69} \ + 9.9999999999999996e-70 +test util-16.1.17.-68 {8.4 compatible formatting of doubles} \ + {expr 1e-68} \ + 1.0000000000000001e-68 +test util-16.1.17.-67 {8.4 compatible formatting of doubles} \ + {expr 1e-67} \ + 9.9999999999999994e-68 +test util-16.1.17.-66 {8.4 compatible formatting of doubles} \ + {expr 1e-66} \ + 9.9999999999999998e-67 +test util-16.1.17.-65 {8.4 compatible formatting of doubles} \ + {expr 1e-65} \ + 9.9999999999999992e-66 +test util-16.1.17.-64 {8.4 compatible formatting of doubles} \ + {expr 1e-64} \ + 9.9999999999999997e-65 +test util-16.1.17.-63 {8.4 compatible formatting of doubles} \ + {expr 1e-63} \ + 1.0000000000000001e-63 +test util-16.1.17.-62 {8.4 compatible formatting of doubles} \ + {expr 1e-62} \ + 1e-62 +test util-16.1.17.-61 {8.4 compatible formatting of doubles} \ + {expr 1e-61} \ + 1e-61 +test util-16.1.17.-60 {8.4 compatible formatting of doubles} \ + {expr 1e-60} \ + 9.9999999999999997e-61 +test util-16.1.17.-59 {8.4 compatible formatting of doubles} \ + {expr 1e-59} \ + 1e-59 +test util-16.1.17.-58 {8.4 compatible formatting of doubles} \ + {expr 1e-58} \ + 1e-58 +test util-16.1.17.-57 {8.4 compatible formatting of doubles} \ + {expr 1e-57} \ + 9.9999999999999995e-58 +test util-16.1.17.-56 {8.4 compatible formatting of doubles} \ + {expr 1e-56} \ + 1e-56 +test util-16.1.17.-55 {8.4 compatible formatting of doubles} \ + {expr 1e-55} \ + 9.9999999999999999e-56 +test util-16.1.17.-54 {8.4 compatible formatting of doubles} \ + {expr 1e-54} \ + 1e-54 +test util-16.1.17.-53 {8.4 compatible formatting of doubles} \ + {expr 1e-53} \ + 1e-53 +test util-16.1.17.-52 {8.4 compatible formatting of doubles} \ + {expr 1e-52} \ + 1e-52 +test util-16.1.17.-51 {8.4 compatible formatting of doubles} \ + {expr 1e-51} \ + 1e-51 +test util-16.1.17.-50 {8.4 compatible formatting of doubles} \ + {expr 1e-50} \ + 1e-50 +test util-16.1.17.-49 {8.4 compatible formatting of doubles} \ + {expr 1e-49} \ + 9.9999999999999994e-50 +test util-16.1.17.-48 {8.4 compatible formatting of doubles} \ + {expr 1e-48} \ + 9.9999999999999997e-49 +test util-16.1.17.-47 {8.4 compatible formatting of doubles} \ + {expr 1e-47} \ + 9.9999999999999997e-48 +test util-16.1.17.-46 {8.4 compatible formatting of doubles} \ + {expr 1e-46} \ + 1e-46 +test util-16.1.17.-45 {8.4 compatible formatting of doubles} \ + {expr 1e-45} \ + 9.9999999999999998e-46 +test util-16.1.17.-44 {8.4 compatible formatting of doubles} \ + {expr 1e-44} \ + 9.9999999999999995e-45 +test util-16.1.17.-43 {8.4 compatible formatting of doubles} \ + {expr 1e-43} \ + 1.0000000000000001e-43 +test util-16.1.17.-42 {8.4 compatible formatting of doubles} \ + {expr 1e-42} \ + 1e-42 +test util-16.1.17.-41 {8.4 compatible formatting of doubles} \ + {expr 1e-41} \ + 1e-41 +test util-16.1.17.-40 {8.4 compatible formatting of doubles} \ + {expr 1e-40} \ + 9.9999999999999993e-41 +test util-16.1.17.-39 {8.4 compatible formatting of doubles} \ + {expr 1e-39} \ + 9.9999999999999993e-40 +test util-16.1.17.-38 {8.4 compatible formatting of doubles} \ + {expr 1e-38} \ + 9.9999999999999996e-39 +test util-16.1.17.-37 {8.4 compatible formatting of doubles} \ + {expr 1e-37} \ + 1.0000000000000001e-37 +test util-16.1.17.-36 {8.4 compatible formatting of doubles} \ + {expr 1e-36} \ + 9.9999999999999994e-37 +test util-16.1.17.-35 {8.4 compatible formatting of doubles} \ + {expr 1e-35} \ + 1e-35 +test util-16.1.17.-34 {8.4 compatible formatting of doubles} \ + {expr 1e-34} \ + 9.9999999999999993e-35 +test util-16.1.17.-33 {8.4 compatible formatting of doubles} \ + {expr 1e-33} \ + 1.0000000000000001e-33 +test util-16.1.17.-32 {8.4 compatible formatting of doubles} \ + {expr 1e-32} \ + 1.0000000000000001e-32 +test util-16.1.17.-31 {8.4 compatible formatting of doubles} \ + {expr 1e-31} \ + 1.0000000000000001e-31 +test util-16.1.17.-30 {8.4 compatible formatting of doubles} \ + {expr 1e-30} \ + 1.0000000000000001e-30 +test util-16.1.17.-29 {8.4 compatible formatting of doubles} \ + {expr 1e-29} \ + 9.9999999999999994e-30 +test util-16.1.17.-28 {8.4 compatible formatting of doubles} \ + {expr 1e-28} \ + 9.9999999999999997e-29 +test util-16.1.17.-27 {8.4 compatible formatting of doubles} \ + {expr 1e-27} \ + 1e-27 +test util-16.1.17.-26 {8.4 compatible formatting of doubles} \ + {expr 1e-26} \ + 1e-26 +test util-16.1.17.-25 {8.4 compatible formatting of doubles} \ + {expr 1e-25} \ + 1e-25 +test util-16.1.17.-24 {8.4 compatible formatting of doubles} \ + {expr 1e-24} \ + 9.9999999999999992e-25 +test util-16.1.17.-23 {8.4 compatible formatting of doubles} \ + {expr 1e-23} \ + 9.9999999999999996e-24 +test util-16.1.17.-22 {8.4 compatible formatting of doubles} \ + {expr 1e-22} \ + 1e-22 +test util-16.1.17.-21 {8.4 compatible formatting of doubles} \ + {expr 1e-21} \ + 9.9999999999999991e-22 +test util-16.1.17.-20 {8.4 compatible formatting of doubles} \ + {expr 1e-20} \ + 9.9999999999999995e-21 +test util-16.1.17.-19 {8.4 compatible formatting of doubles} \ + {expr 1e-19} \ + 9.9999999999999998e-20 +test util-16.1.17.-18 {8.4 compatible formatting of doubles} \ + {expr 1e-18} \ + 1.0000000000000001e-18 +test util-16.1.17.-17 {8.4 compatible formatting of doubles} \ + {expr 1e-17} \ + 1.0000000000000001e-17 +test util-16.1.17.-16 {8.4 compatible formatting of doubles} \ + {expr 1e-16} \ + 9.9999999999999998e-17 +test util-16.1.17.-15 {8.4 compatible formatting of doubles} \ + {expr 1e-15} \ + 1.0000000000000001e-15 +test util-16.1.17.-14 {8.4 compatible formatting of doubles} \ + {expr 1e-14} \ + 1e-14 +test util-16.1.17.-13 {8.4 compatible formatting of doubles} \ + {expr 1e-13} \ + 1e-13 +test util-16.1.17.-12 {8.4 compatible formatting of doubles} \ + {expr 1e-12} \ + 9.9999999999999998e-13 +test util-16.1.17.-11 {8.4 compatible formatting of doubles} \ + {expr 1e-11} \ + 9.9999999999999994e-12 +test util-16.1.17.-10 {8.4 compatible formatting of doubles} \ + {expr 1e-10} \ + 1e-10 +test util-16.1.17.-9 {8.4 compatible formatting of doubles} \ + {expr 1e-9} \ + 1.0000000000000001e-09 +test util-16.1.17.-8 {8.4 compatible formatting of doubles} \ + {expr 1e-8} \ + 1e-08 +test util-16.1.17.-7 {8.4 compatible formatting of doubles} \ + {expr 1e-7} \ + 9.9999999999999995e-08 +test util-16.1.17.-6 {8.4 compatible formatting of doubles} \ + {expr 1e-6} \ + 9.9999999999999995e-07 +test util-16.1.17.-5 {8.4 compatible formatting of doubles} \ + {expr 1e-5} \ + 1.0000000000000001e-05 +test util-16.1.17.-4 {8.4 compatible formatting of doubles} \ + {expr 1e-4} \ + 0.0001 +test util-16.1.17.-3 {8.4 compatible formatting of doubles} \ + {expr 1e-3} \ + 0.001 +test util-16.1.17.-2 {8.4 compatible formatting of doubles} \ + {expr 1e-2} \ + 0.01 +test util-16.1.17.-1 {8.4 compatible formatting of doubles} \ + {expr 1e-1} \ + 0.10000000000000001 +test util-16.1.17.0 {8.4 compatible formatting of doubles} \ + {expr 1e0} \ + 1.0 +test util-16.1.17.1 {8.4 compatible formatting of doubles} \ + {expr 1e1} \ + 10.0 +test util-16.1.17.2 {8.4 compatible formatting of doubles} \ + {expr 1e2} \ + 100.0 +test util-16.1.17.3 {8.4 compatible formatting of doubles} \ + {expr 1e3} \ + 1000.0 +test util-16.1.17.4 {8.4 compatible formatting of doubles} \ + {expr 1e4} \ + 10000.0 +test util-16.1.17.5 {8.4 compatible formatting of doubles} \ + {expr 1e5} \ + 100000.0 +test util-16.1.17.6 {8.4 compatible formatting of doubles} \ + {expr 1e6} \ + 1000000.0 +test util-16.1.17.7 {8.4 compatible formatting of doubles} \ + {expr 1e7} \ + 10000000.0 +test util-16.1.17.8 {8.4 compatible formatting of doubles} \ + {expr 1e8} \ + 100000000.0 +test util-16.1.17.9 {8.4 compatible formatting of doubles} \ + {expr 1e9} \ + 1000000000.0 +test util-16.1.17.10 {8.4 compatible formatting of doubles} \ + {expr 1e10} \ + 10000000000.0 +test util-16.1.17.11 {8.4 compatible formatting of doubles} \ + {expr 1e11} \ + 100000000000.0 +test util-16.1.17.12 {8.4 compatible formatting of doubles} \ + {expr 1e12} \ + 1000000000000.0 +test util-16.1.17.13 {8.4 compatible formatting of doubles} \ + {expr 1e13} \ + 10000000000000.0 +test util-16.1.17.14 {8.4 compatible formatting of doubles} \ + {expr 1e14} \ + 100000000000000.0 +test util-16.1.17.15 {8.4 compatible formatting of doubles} \ + {expr 1e15} \ + 1000000000000000.0 +test util-16.1.17.16 {8.4 compatible formatting of doubles} \ + {expr 1e16} \ + 10000000000000000.0 +test util-16.1.17.17 {8.4 compatible formatting of doubles} \ + {expr 1e17} \ + 1e+17 +test util-16.1.17.18 {8.4 compatible formatting of doubles} \ + {expr 1e18} \ + 1e+18 +test util-16.1.17.19 {8.4 compatible formatting of doubles} \ + {expr 1e19} \ + 1e+19 +test util-16.1.17.20 {8.4 compatible formatting of doubles} \ + {expr 1e20} \ + 1e+20 +test util-16.1.17.21 {8.4 compatible formatting of doubles} \ + {expr 1e21} \ + 1e+21 +test util-16.1.17.22 {8.4 compatible formatting of doubles} \ + {expr 1e22} \ + 1e+22 +test util-16.1.17.23 {8.4 compatible formatting of doubles} \ + {expr 1e23} \ + 9.9999999999999992e+22 +test util-16.1.17.24 {8.4 compatible formatting of doubles} \ + {expr 1e24} \ + 9.9999999999999998e+23 +test util-16.1.17.25 {8.4 compatible formatting of doubles} \ + {expr 1e25} \ + 1.0000000000000001e+25 +test util-16.1.17.26 {8.4 compatible formatting of doubles} \ + {expr 1e26} \ + 1e+26 +test util-16.1.17.27 {8.4 compatible formatting of doubles} \ + {expr 1e27} \ + 1e+27 +test util-16.1.17.28 {8.4 compatible formatting of doubles} \ + {expr 1e28} \ + 9.9999999999999996e+27 +test util-16.1.17.29 {8.4 compatible formatting of doubles} \ + {expr 1e29} \ + 9.9999999999999991e+28 +test util-16.1.17.30 {8.4 compatible formatting of doubles} \ + {expr 1e30} \ + 1e+30 +test util-16.1.17.31 {8.4 compatible formatting of doubles} \ + {expr 1e31} \ + 9.9999999999999996e+30 +test util-16.1.17.32 {8.4 compatible formatting of doubles} \ + {expr 1e32} \ + 1.0000000000000001e+32 +test util-16.1.17.33 {8.4 compatible formatting of doubles} \ + {expr 1e33} \ + 9.9999999999999995e+32 +test util-16.1.17.34 {8.4 compatible formatting of doubles} \ + {expr 1e34} \ + 9.9999999999999995e+33 +test util-16.1.17.35 {8.4 compatible formatting of doubles} \ + {expr 1e35} \ + 9.9999999999999997e+34 +test util-16.1.17.36 {8.4 compatible formatting of doubles} \ + {expr 1e36} \ + 1e+36 +test util-16.1.17.37 {8.4 compatible formatting of doubles} \ + {expr 1e37} \ + 9.9999999999999995e+36 +test util-16.1.17.38 {8.4 compatible formatting of doubles} \ + {expr 1e38} \ + 9.9999999999999998e+37 +test util-16.1.17.39 {8.4 compatible formatting of doubles} \ + {expr 1e39} \ + 9.9999999999999994e+38 +test util-16.1.17.40 {8.4 compatible formatting of doubles} \ + {expr 1e40} \ + 1e+40 +test util-16.1.17.41 {8.4 compatible formatting of doubles} \ + {expr 1e41} \ + 1e+41 +test util-16.1.17.42 {8.4 compatible formatting of doubles} \ + {expr 1e42} \ + 1e+42 +test util-16.1.17.43 {8.4 compatible formatting of doubles} \ + {expr 1e43} \ + 1e+43 +test util-16.1.17.44 {8.4 compatible formatting of doubles} \ + {expr 1e44} \ + 1.0000000000000001e+44 +test util-16.1.17.45 {8.4 compatible formatting of doubles} \ + {expr 1e45} \ + 9.9999999999999993e+44 +test util-16.1.17.46 {8.4 compatible formatting of doubles} \ + {expr 1e46} \ + 9.9999999999999999e+45 +test util-16.1.17.47 {8.4 compatible formatting of doubles} \ + {expr 1e47} \ + 1e+47 +test util-16.1.17.48 {8.4 compatible formatting of doubles} \ + {expr 1e48} \ + 1e+48 +test util-16.1.17.49 {8.4 compatible formatting of doubles} \ + {expr 1e49} \ + 9.9999999999999995e+48 +test util-16.1.17.50 {8.4 compatible formatting of doubles} \ + {expr 1e50} \ + 1.0000000000000001e+50 +test util-16.1.17.51 {8.4 compatible formatting of doubles} \ + {expr 1e51} \ + 9.9999999999999999e+50 +test util-16.1.17.52 {8.4 compatible formatting of doubles} \ + {expr 1e52} \ + 9.9999999999999999e+51 +test util-16.1.17.53 {8.4 compatible formatting of doubles} \ + {expr 1e53} \ + 9.9999999999999999e+52 +test util-16.1.17.54 {8.4 compatible formatting of doubles} \ + {expr 1e54} \ + 1.0000000000000001e+54 +test util-16.1.17.55 {8.4 compatible formatting of doubles} \ + {expr 1e55} \ + 1e+55 +test util-16.1.17.56 {8.4 compatible formatting of doubles} \ + {expr 1e56} \ + 1.0000000000000001e+56 +test util-16.1.17.57 {8.4 compatible formatting of doubles} \ + {expr 1e57} \ + 1e+57 +test util-16.1.17.58 {8.4 compatible formatting of doubles} \ + {expr 1e58} \ + 9.9999999999999994e+57 +test util-16.1.17.59 {8.4 compatible formatting of doubles} \ + {expr 1e59} \ + 9.9999999999999997e+58 +test util-16.1.17.60 {8.4 compatible formatting of doubles} \ + {expr 1e60} \ + 9.9999999999999995e+59 +test util-16.1.17.61 {8.4 compatible formatting of doubles} \ + {expr 1e61} \ + 9.9999999999999995e+60 +test util-16.1.17.62 {8.4 compatible formatting of doubles} \ + {expr 1e62} \ + 1e+62 +test util-16.1.17.63 {8.4 compatible formatting of doubles} \ + {expr 1e63} \ + 1.0000000000000001e+63 +test util-16.1.17.64 {8.4 compatible formatting of doubles} \ + {expr 1e64} \ + 1e+64 +test util-16.1.17.65 {8.4 compatible formatting of doubles} \ + {expr 1e65} \ + 9.9999999999999999e+64 +test util-16.1.17.66 {8.4 compatible formatting of doubles} \ + {expr 1e66} \ + 9.9999999999999995e+65 +test util-16.1.17.67 {8.4 compatible formatting of doubles} \ + {expr 1e67} \ + 9.9999999999999998e+66 +test util-16.1.17.68 {8.4 compatible formatting of doubles} \ + {expr 1e68} \ + 9.9999999999999995e+67 +test util-16.1.17.69 {8.4 compatible formatting of doubles} \ + {expr 1e69} \ + 1.0000000000000001e+69 +test util-16.1.17.70 {8.4 compatible formatting of doubles} \ + {expr 1e70} \ + 1.0000000000000001e+70 +test util-16.1.17.71 {8.4 compatible formatting of doubles} \ + {expr 1e71} \ + 1e+71 +test util-16.1.17.72 {8.4 compatible formatting of doubles} \ + {expr 1e72} \ + 9.9999999999999994e+71 +test util-16.1.17.73 {8.4 compatible formatting of doubles} \ + {expr 1e73} \ + 9.9999999999999998e+72 +test util-16.1.17.74 {8.4 compatible formatting of doubles} \ + {expr 1e74} \ + 9.9999999999999995e+73 +test util-16.1.17.75 {8.4 compatible formatting of doubles} \ + {expr 1e75} \ + 9.9999999999999993e+74 +test util-16.1.17.76 {8.4 compatible formatting of doubles} \ + {expr 1e76} \ + 1e+76 +test util-16.1.17.77 {8.4 compatible formatting of doubles} \ + {expr 1e77} \ + 9.9999999999999998e+76 +test util-16.1.17.78 {8.4 compatible formatting of doubles} \ + {expr 1e78} \ + 1e+78 +test util-16.1.17.79 {8.4 compatible formatting of doubles} \ + {expr 1e79} \ + 9.9999999999999997e+78 +test util-16.1.17.80 {8.4 compatible formatting of doubles} \ + {expr 1e80} \ + 1e+80 +test util-16.1.17.81 {8.4 compatible formatting of doubles} \ + {expr 1e81} \ + 9.9999999999999992e+80 +test util-16.1.17.82 {8.4 compatible formatting of doubles} \ + {expr 1e82} \ + 9.9999999999999996e+81 +test util-16.1.17.83 {8.4 compatible formatting of doubles} \ + {expr 1e83} \ + 1e+83 +test util-16.1.17.84 {8.4 compatible formatting of doubles} \ + {expr 1e84} \ + 1.0000000000000001e+84 +test util-16.1.17.85 {8.4 compatible formatting of doubles} \ + {expr 1e85} \ + 1e+85 +test util-16.1.17.86 {8.4 compatible formatting of doubles} \ + {expr 1e86} \ + 1e+86 +test util-16.1.17.87 {8.4 compatible formatting of doubles} \ + {expr 1e87} \ + 9.9999999999999996e+86 +test util-16.1.17.88 {8.4 compatible formatting of doubles} \ + {expr 1e88} \ + 9.9999999999999996e+87 +test util-16.1.17.89 {8.4 compatible formatting of doubles} \ + {expr 1e89} \ + 9.9999999999999999e+88 +test util-16.1.17.90 {8.4 compatible formatting of doubles} \ + {expr 1e90} \ + 9.9999999999999997e+89 +test util-16.1.17.91 {8.4 compatible formatting of doubles} \ + {expr 1e91} \ + 1.0000000000000001e+91 +test util-16.1.17.92 {8.4 compatible formatting of doubles} \ + {expr 1e92} \ + 1e+92 +test util-16.1.17.93 {8.4 compatible formatting of doubles} \ + {expr 1e93} \ + 1e+93 +test util-16.1.17.94 {8.4 compatible formatting of doubles} \ + {expr 1e94} \ + 1e+94 +test util-16.1.17.95 {8.4 compatible formatting of doubles} \ + {expr 1e95} \ + 1e+95 +test util-16.1.17.96 {8.4 compatible formatting of doubles} \ + {expr 1e96} \ + 1e+96 +test util-16.1.17.97 {8.4 compatible formatting of doubles} \ + {expr 1e97} \ + 1.0000000000000001e+97 +test util-16.1.17.98 {8.4 compatible formatting of doubles} \ + {expr 1e98} \ + 1e+98 +test util-16.1.17.99 {8.4 compatible formatting of doubles} \ + {expr 1e99} \ + 9.9999999999999997e+98 +test util-16.1.17.100 {8.4 compatible formatting of doubles} \ + {expr 1e100} \ + 1e+100 +test util-16.1.17.101 {8.4 compatible formatting of doubles} \ + {expr 1e101} \ + 9.9999999999999998e+100 +test util-16.1.17.102 {8.4 compatible formatting of doubles} \ + {expr 1e102} \ + 9.9999999999999998e+101 +test util-16.1.17.103 {8.4 compatible formatting of doubles} \ + {expr 1e103} \ + 1e+103 +test util-16.1.17.104 {8.4 compatible formatting of doubles} \ + {expr 1e104} \ + 1e+104 +test util-16.1.17.105 {8.4 compatible formatting of doubles} \ + {expr 1e105} \ + 9.9999999999999994e+104 +test util-16.1.17.106 {8.4 compatible formatting of doubles} \ + {expr 1e106} \ + 1.0000000000000001e+106 +test util-16.1.17.107 {8.4 compatible formatting of doubles} \ + {expr 1e107} \ + 9.9999999999999997e+106 +test util-16.1.17.108 {8.4 compatible formatting of doubles} \ + {expr 1e108} \ + 1e+108 +test util-16.1.17.109 {8.4 compatible formatting of doubles} \ + {expr 1e109} \ + 9.9999999999999998e+108 +test util-16.1.17.110 {8.4 compatible formatting of doubles} \ + {expr 1e110} \ + 1e+110 +test util-16.1.17.111 {8.4 compatible formatting of doubles} \ + {expr 1e111} \ + 9.9999999999999996e+110 +test util-16.1.17.112 {8.4 compatible formatting of doubles} \ + {expr 1e112} \ + 9.9999999999999993e+111 +test util-16.1.17.113 {8.4 compatible formatting of doubles} \ + {expr 1e113} \ + 1e+113 +test util-16.1.17.114 {8.4 compatible formatting of doubles} \ + {expr 1e114} \ + 1e+114 +test util-16.1.17.115 {8.4 compatible formatting of doubles} \ + {expr 1e115} \ + 1e+115 +test util-16.1.17.116 {8.4 compatible formatting of doubles} \ + {expr 1e116} \ + 1e+116 +test util-16.1.17.117 {8.4 compatible formatting of doubles} \ + {expr 1e117} \ + 1.0000000000000001e+117 +test util-16.1.17.118 {8.4 compatible formatting of doubles} \ + {expr 1e118} \ + 9.9999999999999997e+117 +test util-16.1.17.119 {8.4 compatible formatting of doubles} \ + {expr 1e119} \ + 9.9999999999999994e+118 +test util-16.1.17.120 {8.4 compatible formatting of doubles} \ + {expr 1e120} \ + 9.9999999999999998e+119 +test util-16.1.17.121 {8.4 compatible formatting of doubles} \ + {expr 1e121} \ + 1e+121 +test util-16.1.17.122 {8.4 compatible formatting of doubles} \ + {expr 1e122} \ + 1e+122 +test util-16.1.17.123 {8.4 compatible formatting of doubles} \ + {expr 1e123} \ + 9.9999999999999998e+122 +test util-16.1.17.124 {8.4 compatible formatting of doubles} \ + {expr 1e124} \ + 9.9999999999999995e+123 +test util-16.1.17.125 {8.4 compatible formatting of doubles} \ + {expr 1e125} \ + 9.9999999999999992e+124 +test util-16.1.17.126 {8.4 compatible formatting of doubles} \ + {expr 1e126} \ + 9.9999999999999992e+125 +test util-16.1.17.127 {8.4 compatible formatting of doubles} \ + {expr 1e127} \ + 9.9999999999999995e+126 +test util-16.1.17.128 {8.4 compatible formatting of doubles} \ + {expr 1e128} \ + 1.0000000000000001e+128 +test util-16.1.17.129 {8.4 compatible formatting of doubles} \ + {expr 1e129} \ + 1e+129 +test util-16.1.17.130 {8.4 compatible formatting of doubles} \ + {expr 1e130} \ + 1.0000000000000001e+130 +test util-16.1.17.131 {8.4 compatible formatting of doubles} \ + {expr 1e131} \ + 9.9999999999999991e+130 +test util-16.1.17.132 {8.4 compatible formatting of doubles} \ + {expr 1e132} \ + 9.9999999999999999e+131 +test util-16.1.17.133 {8.4 compatible formatting of doubles} \ + {expr 1e133} \ + 1e+133 +test util-16.1.17.134 {8.4 compatible formatting of doubles} \ + {expr 1e134} \ + 9.9999999999999992e+133 +test util-16.1.17.135 {8.4 compatible formatting of doubles} \ + {expr 1e135} \ + 9.9999999999999996e+134 +test util-16.1.17.136 {8.4 compatible formatting of doubles} \ + {expr 1e136} \ + 1.0000000000000001e+136 +test util-16.1.17.137 {8.4 compatible formatting of doubles} \ + {expr 1e137} \ + 1e+137 +test util-16.1.17.138 {8.4 compatible formatting of doubles} \ + {expr 1e138} \ + 1e+138 +test util-16.1.17.139 {8.4 compatible formatting of doubles} \ + {expr 1e139} \ + 1e+139 +test util-16.1.17.140 {8.4 compatible formatting of doubles} \ + {expr 1e140} \ + 1.0000000000000001e+140 +test util-16.1.17.141 {8.4 compatible formatting of doubles} \ + {expr 1e141} \ + 1e+141 +test util-16.1.17.142 {8.4 compatible formatting of doubles} \ + {expr 1e142} \ + 1.0000000000000001e+142 +test util-16.1.17.143 {8.4 compatible formatting of doubles} \ + {expr 1e143} \ + 1e+143 +test util-16.1.17.144 {8.4 compatible formatting of doubles} \ + {expr 1e144} \ + 1e+144 +test util-16.1.17.145 {8.4 compatible formatting of doubles} \ + {expr 1e145} \ + 9.9999999999999999e+144 +test util-16.1.17.146 {8.4 compatible formatting of doubles} \ + {expr 1e146} \ + 9.9999999999999993e+145 +test util-16.1.17.147 {8.4 compatible formatting of doubles} \ + {expr 1e147} \ + 9.9999999999999998e+146 +test util-16.1.17.148 {8.4 compatible formatting of doubles} \ + {expr 1e148} \ + 1e+148 +test util-16.1.17.149 {8.4 compatible formatting of doubles} \ + {expr 1e149} \ + 1e+149 +test util-16.1.17.150 {8.4 compatible formatting of doubles} \ + {expr 1e150} \ + 9.9999999999999998e+149 +test util-16.1.17.151 {8.4 compatible formatting of doubles} \ + {expr 1e151} \ + 1e+151 +test util-16.1.17.152 {8.4 compatible formatting of doubles} \ + {expr 1e152} \ + 1e+152 +test util-16.1.17.153 {8.4 compatible formatting of doubles} \ + {expr 1e153} \ + 1e+153 +test util-16.1.17.154 {8.4 compatible formatting of doubles} \ + {expr 1e154} \ + 1e+154 +test util-16.1.17.155 {8.4 compatible formatting of doubles} \ + {expr 1e155} \ + 1e+155 +test util-16.1.17.156 {8.4 compatible formatting of doubles} \ + {expr 1e156} \ + 9.9999999999999998e+155 +test util-16.1.17.157 {8.4 compatible formatting of doubles} \ + {expr 1e157} \ + 9.9999999999999998e+156 +test util-16.1.17.158 {8.4 compatible formatting of doubles} \ + {expr 1e158} \ + 9.9999999999999995e+157 +test util-16.1.17.159 {8.4 compatible formatting of doubles} \ + {expr 1e159} \ + 9.9999999999999993e+158 +test util-16.1.17.160 {8.4 compatible formatting of doubles} \ + {expr 1e160} \ + 1e+160 +test util-16.1.17.161 {8.4 compatible formatting of doubles} \ + {expr 1e161} \ + 1e+161 +test util-16.1.17.162 {8.4 compatible formatting of doubles} \ + {expr 1e162} \ + 9.9999999999999994e+161 +test util-16.1.17.163 {8.4 compatible formatting of doubles} \ + {expr 1e163} \ + 9.9999999999999994e+162 +test util-16.1.17.164 {8.4 compatible formatting of doubles} \ + {expr 1e164} \ + 1e+164 +test util-16.1.17.165 {8.4 compatible formatting of doubles} \ + {expr 1e165} \ + 9.999999999999999e+164 +test util-16.1.17.166 {8.4 compatible formatting of doubles} \ + {expr 1e166} \ + 9.9999999999999994e+165 +test util-16.1.17.167 {8.4 compatible formatting of doubles} \ + {expr 1e167} \ + 1e+167 +test util-16.1.17.168 {8.4 compatible formatting of doubles} \ + {expr 1e168} \ + 9.9999999999999993e+167 +test util-16.1.17.169 {8.4 compatible formatting of doubles} \ + {expr 1e169} \ + 9.9999999999999993e+168 +test util-16.1.17.170 {8.4 compatible formatting of doubles} \ + {expr 1e170} \ + 1e+170 +test util-16.1.17.171 {8.4 compatible formatting of doubles} \ + {expr 1e171} \ + 9.9999999999999995e+170 +test util-16.1.17.172 {8.4 compatible formatting of doubles} \ + {expr 1e172} \ + 1.0000000000000001e+172 +test util-16.1.17.173 {8.4 compatible formatting of doubles} \ + {expr 1e173} \ + 1e+173 +test util-16.1.17.174 {8.4 compatible formatting of doubles} \ + {expr 1e174} \ + 1.0000000000000001e+174 +test util-16.1.17.175 {8.4 compatible formatting of doubles} \ + {expr 1e175} \ + 9.9999999999999994e+174 +test util-16.1.17.176 {8.4 compatible formatting of doubles} \ + {expr 1e176} \ + 1e+176 +test util-16.1.17.177 {8.4 compatible formatting of doubles} \ + {expr 1e177} \ + 1e+177 +test util-16.1.17.178 {8.4 compatible formatting of doubles} \ + {expr 1e178} \ + 1.0000000000000001e+178 +test util-16.1.17.179 {8.4 compatible formatting of doubles} \ + {expr 1e179} \ + 9.9999999999999998e+178 +test util-16.1.17.180 {8.4 compatible formatting of doubles} \ + {expr 1e180} \ + 1e+180 +test util-16.1.17.181 {8.4 compatible formatting of doubles} \ + {expr 1e181} \ + 9.9999999999999992e+180 +test util-16.1.17.182 {8.4 compatible formatting of doubles} \ + {expr 1e182} \ + 1.0000000000000001e+182 +test util-16.1.17.183 {8.4 compatible formatting of doubles} \ + {expr 1e183} \ + 9.9999999999999995e+182 +test util-16.1.17.184 {8.4 compatible formatting of doubles} \ + {expr 1e184} \ + 1e+184 +test util-16.1.17.185 {8.4 compatible formatting of doubles} \ + {expr 1e185} \ + 9.9999999999999998e+184 +test util-16.1.17.186 {8.4 compatible formatting of doubles} \ + {expr 1e186} \ + 9.9999999999999998e+185 +test util-16.1.17.187 {8.4 compatible formatting of doubles} \ + {expr 1e187} \ + 9.9999999999999991e+186 +test util-16.1.17.188 {8.4 compatible formatting of doubles} \ + {expr 1e188} \ + 1e+188 +test util-16.1.17.189 {8.4 compatible formatting of doubles} \ + {expr 1e189} \ + 1e+189 +test util-16.1.17.190 {8.4 compatible formatting of doubles} \ + {expr 1e190} \ + 1.0000000000000001e+190 +test util-16.1.17.191 {8.4 compatible formatting of doubles} \ + {expr 1e191} \ + 1.0000000000000001e+191 +test util-16.1.17.192 {8.4 compatible formatting of doubles} \ + {expr 1e192} \ + 1e+192 +test util-16.1.17.193 {8.4 compatible formatting of doubles} \ + {expr 1e193} \ + 1.0000000000000001e+193 +test util-16.1.17.194 {8.4 compatible formatting of doubles} \ + {expr 1e194} \ + 9.9999999999999994e+193 +test util-16.1.17.195 {8.4 compatible formatting of doubles} \ + {expr 1e195} \ + 9.9999999999999998e+194 +test util-16.1.17.196 {8.4 compatible formatting of doubles} \ + {expr 1e196} \ + 9.9999999999999995e+195 +test util-16.1.17.197 {8.4 compatible formatting of doubles} \ + {expr 1e197} \ + 9.9999999999999995e+196 +test util-16.1.17.198 {8.4 compatible formatting of doubles} \ + {expr 1e198} \ + 1e+198 +test util-16.1.17.199 {8.4 compatible formatting of doubles} \ + {expr 1e199} \ + 1.0000000000000001e+199 +test util-16.1.17.200 {8.4 compatible formatting of doubles} \ + {expr 1e200} \ + 9.9999999999999997e+199 +test util-16.1.17.201 {8.4 compatible formatting of doubles} \ + {expr 1e201} \ + 1e+201 +test util-16.1.17.202 {8.4 compatible formatting of doubles} \ + {expr 1e202} \ + 9.999999999999999e+201 +test util-16.1.17.203 {8.4 compatible formatting of doubles} \ + {expr 1e203} \ + 9.9999999999999999e+202 +test util-16.1.17.204 {8.4 compatible formatting of doubles} \ + {expr 1e204} \ + 9.9999999999999999e+203 +test util-16.1.17.205 {8.4 compatible formatting of doubles} \ + {expr 1e205} \ + 1e+205 +test util-16.1.17.206 {8.4 compatible formatting of doubles} \ + {expr 1e206} \ + 1e+206 +test util-16.1.17.207 {8.4 compatible formatting of doubles} \ + {expr 1e207} \ + 1e+207 +test util-16.1.17.208 {8.4 compatible formatting of doubles} \ + {expr 1e208} \ + 9.9999999999999998e+207 +test util-16.1.17.209 {8.4 compatible formatting of doubles} \ + {expr 1e209} \ + 1.0000000000000001e+209 +test util-16.1.17.210 {8.4 compatible formatting of doubles} \ + {expr 1e210} \ + 9.9999999999999993e+209 +test util-16.1.17.211 {8.4 compatible formatting of doubles} \ + {expr 1e211} \ + 9.9999999999999996e+210 +test util-16.1.17.212 {8.4 compatible formatting of doubles} \ + {expr 1e212} \ + 9.9999999999999991e+211 +test util-16.1.17.213 {8.4 compatible formatting of doubles} \ + {expr 1e213} \ + 9.9999999999999998e+212 +test util-16.1.17.214 {8.4 compatible formatting of doubles} \ + {expr 1e214} \ + 9.9999999999999995e+213 +test util-16.1.17.215 {8.4 compatible formatting of doubles} \ + {expr 1e215} \ + 9.9999999999999991e+214 +test util-16.1.17.216 {8.4 compatible formatting of doubles} \ + {expr 1e216} \ + 1e+216 +test util-16.1.17.217 {8.4 compatible formatting of doubles} \ + {expr 1e217} \ + 9.9999999999999996e+216 +test util-16.1.17.218 {8.4 compatible formatting of doubles} \ + {expr 1e218} \ + 1.0000000000000001e+218 +test util-16.1.17.219 {8.4 compatible formatting of doubles} \ + {expr 1e219} \ + 9.9999999999999997e+218 +test util-16.1.17.220 {8.4 compatible formatting of doubles} \ + {expr 1e220} \ + 1e+220 +test util-16.1.17.221 {8.4 compatible formatting of doubles} \ + {expr 1e221} \ + 1e+221 +test util-16.1.17.222 {8.4 compatible formatting of doubles} \ + {expr 1e222} \ + 1e+222 +test util-16.1.17.223 {8.4 compatible formatting of doubles} \ + {expr 1e223} \ + 1e+223 +test util-16.1.17.224 {8.4 compatible formatting of doubles} \ + {expr 1e224} \ + 9.9999999999999997e+223 +test util-16.1.17.225 {8.4 compatible formatting of doubles} \ + {expr 1e225} \ + 9.9999999999999993e+224 +test util-16.1.17.226 {8.4 compatible formatting of doubles} \ + {expr 1e226} \ + 9.9999999999999996e+225 +test util-16.1.17.227 {8.4 compatible formatting of doubles} \ + {expr 1e227} \ + 1.0000000000000001e+227 +test util-16.1.17.228 {8.4 compatible formatting of doubles} \ + {expr 1e228} \ + 9.9999999999999992e+227 +test util-16.1.17.229 {8.4 compatible formatting of doubles} \ + {expr 1e229} \ + 9.9999999999999999e+228 +test util-16.1.17.230 {8.4 compatible formatting of doubles} \ + {expr 1e230} \ + 1.0000000000000001e+230 +test util-16.1.17.231 {8.4 compatible formatting of doubles} \ + {expr 1e231} \ + 1.0000000000000001e+231 +test util-16.1.17.232 {8.4 compatible formatting of doubles} \ + {expr 1e232} \ + 1.0000000000000001e+232 +test util-16.1.17.233 {8.4 compatible formatting of doubles} \ + {expr 1e233} \ + 9.9999999999999997e+232 +test util-16.1.17.234 {8.4 compatible formatting of doubles} \ + {expr 1e234} \ + 1e+234 +test util-16.1.17.235 {8.4 compatible formatting of doubles} \ + {expr 1e235} \ + 1.0000000000000001e+235 +test util-16.1.17.236 {8.4 compatible formatting of doubles} \ + {expr 1e236} \ + 1.0000000000000001e+236 +test util-16.1.17.237 {8.4 compatible formatting of doubles} \ + {expr 1e237} \ + 9.9999999999999994e+236 +test util-16.1.17.238 {8.4 compatible formatting of doubles} \ + {expr 1e238} \ + 1e+238 +test util-16.1.17.239 {8.4 compatible formatting of doubles} \ + {expr 1e239} \ + 9.9999999999999999e+238 +test util-16.1.17.240 {8.4 compatible formatting of doubles} \ + {expr 1e240} \ + 1e+240 +test util-16.1.17.241 {8.4 compatible formatting of doubles} \ + {expr 1e241} \ + 1.0000000000000001e+241 +test util-16.1.17.242 {8.4 compatible formatting of doubles} \ + {expr 1e242} \ + 1.0000000000000001e+242 +test util-16.1.17.243 {8.4 compatible formatting of doubles} \ + {expr 1e243} \ + 1.0000000000000001e+243 +test util-16.1.17.244 {8.4 compatible formatting of doubles} \ + {expr 1e244} \ + 1.0000000000000001e+244 +test util-16.1.17.245 {8.4 compatible formatting of doubles} \ + {expr 1e245} \ + 1e+245 +test util-16.1.17.246 {8.4 compatible formatting of doubles} \ + {expr 1e246} \ + 1.0000000000000001e+246 +test util-16.1.17.247 {8.4 compatible formatting of doubles} \ + {expr 1e247} \ + 9.9999999999999995e+246 +test util-16.1.17.248 {8.4 compatible formatting of doubles} \ + {expr 1e248} \ + 1e+248 +test util-16.1.17.249 {8.4 compatible formatting of doubles} \ + {expr 1e249} \ + 9.9999999999999992e+248 +test util-16.1.17.250 {8.4 compatible formatting of doubles} \ + {expr 1e250} \ + 9.9999999999999992e+249 +test util-16.1.17.251 {8.4 compatible formatting of doubles} \ + {expr 1e251} \ + 1e+251 +test util-16.1.17.252 {8.4 compatible formatting of doubles} \ + {expr 1e252} \ + 1.0000000000000001e+252 +test util-16.1.17.253 {8.4 compatible formatting of doubles} \ + {expr 1e253} \ + 9.9999999999999994e+252 +test util-16.1.17.254 {8.4 compatible formatting of doubles} \ + {expr 1e254} \ + 9.9999999999999994e+253 +test util-16.1.17.255 {8.4 compatible formatting of doubles} \ + {expr 1e255} \ + 9.9999999999999999e+254 +test util-16.1.17.256 {8.4 compatible formatting of doubles} \ + {expr 1e256} \ + 1e+256 +test util-16.1.17.257 {8.4 compatible formatting of doubles} \ + {expr 1e257} \ + 1e+257 +test util-16.1.17.258 {8.4 compatible formatting of doubles} \ + {expr 1e258} \ + 1.0000000000000001e+258 +test util-16.1.17.259 {8.4 compatible formatting of doubles} \ + {expr 1e259} \ + 9.9999999999999993e+258 +test util-16.1.17.260 {8.4 compatible formatting of doubles} \ + {expr 1e260} \ + 1.0000000000000001e+260 +test util-16.1.17.261 {8.4 compatible formatting of doubles} \ + {expr 1e261} \ + 9.9999999999999993e+260 +test util-16.1.17.262 {8.4 compatible formatting of doubles} \ + {expr 1e262} \ + 1e+262 +test util-16.1.17.263 {8.4 compatible formatting of doubles} \ + {expr 1e263} \ + 1e+263 +test util-16.1.17.264 {8.4 compatible formatting of doubles} \ + {expr 1e264} \ + 1e+264 +test util-16.1.17.265 {8.4 compatible formatting of doubles} \ + {expr 1e265} \ + 1.0000000000000001e+265 +test util-16.1.17.266 {8.4 compatible formatting of doubles} \ + {expr 1e266} \ + 1e+266 +test util-16.1.17.267 {8.4 compatible formatting of doubles} \ + {expr 1e267} \ + 9.9999999999999997e+266 +test util-16.1.17.268 {8.4 compatible formatting of doubles} \ + {expr 1e268} \ + 9.9999999999999997e+267 +test util-16.1.17.269 {8.4 compatible formatting of doubles} \ + {expr 1e269} \ + 1e+269 +test util-16.1.17.270 {8.4 compatible formatting of doubles} \ + {expr 1e270} \ + 1e+270 +test util-16.1.17.271 {8.4 compatible formatting of doubles} \ + {expr 1e271} \ + 9.9999999999999995e+270 +test util-16.1.17.272 {8.4 compatible formatting of doubles} \ + {expr 1e272} \ + 1.0000000000000001e+272 +test util-16.1.17.273 {8.4 compatible formatting of doubles} \ + {expr 1e273} \ + 9.9999999999999995e+272 +test util-16.1.17.274 {8.4 compatible formatting of doubles} \ + {expr 1e274} \ + 9.9999999999999992e+273 +test util-16.1.17.275 {8.4 compatible formatting of doubles} \ + {expr 1e275} \ + 9.9999999999999996e+274 +test util-16.1.17.276 {8.4 compatible formatting of doubles} \ + {expr 1e276} \ + 1.0000000000000001e+276 +test util-16.1.17.277 {8.4 compatible formatting of doubles} \ + {expr 1e277} \ + 1e+277 +test util-16.1.17.278 {8.4 compatible formatting of doubles} \ + {expr 1e278} \ + 9.9999999999999996e+277 +test util-16.1.17.279 {8.4 compatible formatting of doubles} \ + {expr 1e279} \ + 1.0000000000000001e+279 +test util-16.1.17.280 {8.4 compatible formatting of doubles} \ + {expr 1e280} \ + 1e+280 +test util-16.1.17.281 {8.4 compatible formatting of doubles} \ + {expr 1e281} \ + 1e+281 +test util-16.1.17.282 {8.4 compatible formatting of doubles} \ + {expr 1e282} \ + 1e+282 +test util-16.1.17.283 {8.4 compatible formatting of doubles} \ + {expr 1e283} \ + 9.9999999999999996e+282 +test util-16.1.17.284 {8.4 compatible formatting of doubles} \ + {expr 1e284} \ + 1.0000000000000001e+284 +test util-16.1.17.285 {8.4 compatible formatting of doubles} \ + {expr 1e285} \ + 9.9999999999999998e+284 +test util-16.1.17.286 {8.4 compatible formatting of doubles} \ + {expr 1e286} \ + 1e+286 +test util-16.1.17.287 {8.4 compatible formatting of doubles} \ + {expr 1e287} \ + 1.0000000000000001e+287 +test util-16.1.17.288 {8.4 compatible formatting of doubles} \ + {expr 1e288} \ + 1e+288 +test util-16.1.17.289 {8.4 compatible formatting of doubles} \ + {expr 1e289} \ + 1.0000000000000001e+289 +test util-16.1.17.290 {8.4 compatible formatting of doubles} \ + {expr 1e290} \ + 1.0000000000000001e+290 +test util-16.1.17.291 {8.4 compatible formatting of doubles} \ + {expr 1e291} \ + 9.9999999999999996e+290 +test util-16.1.17.292 {8.4 compatible formatting of doubles} \ + {expr 1e292} \ + 1e+292 +test util-16.1.17.293 {8.4 compatible formatting of doubles} \ + {expr 1e293} \ + 9.9999999999999992e+292 +test util-16.1.17.294 {8.4 compatible formatting of doubles} \ + {expr 1e294} \ + 1.0000000000000001e+294 +test util-16.1.17.295 {8.4 compatible formatting of doubles} \ + {expr 1e295} \ + 9.9999999999999998e+294 +test util-16.1.17.296 {8.4 compatible formatting of doubles} \ + {expr 1e296} \ + 9.9999999999999998e+295 +test util-16.1.17.297 {8.4 compatible formatting of doubles} \ + {expr 1e297} \ + 1e+297 +test util-16.1.17.298 {8.4 compatible formatting of doubles} \ + {expr 1e298} \ + 9.9999999999999996e+297 +test util-16.1.17.299 {8.4 compatible formatting of doubles} \ + {expr 1e299} \ + 1.0000000000000001e+299 +test util-16.1.17.300 {8.4 compatible formatting of doubles} \ + {expr 1e300} \ + 1.0000000000000001e+300 +test util-16.1.17.301 {8.4 compatible formatting of doubles} \ + {expr 1e301} \ + 1.0000000000000001e+301 +test util-16.1.17.302 {8.4 compatible formatting of doubles} \ + {expr 1e302} \ + 1.0000000000000001e+302 +test util-16.1.17.303 {8.4 compatible formatting of doubles} \ + {expr 1e303} \ + 1e+303 +test util-16.1.17.304 {8.4 compatible formatting of doubles} \ + {expr 1e304} \ + 9.9999999999999994e+303 +test util-16.1.17.305 {8.4 compatible formatting of doubles} \ + {expr 1e305} \ + 9.9999999999999994e+304 +test util-16.1.17.306 {8.4 compatible formatting of doubles} \ + {expr 1e306} \ + 1e+306 +test util-16.1.17.307 {8.4 compatible formatting of doubles} \ + {expr 1e307} \ + 9.9999999999999999e+306 + +set ::tcl_precision $saved_precision + # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl -# End:
\ No newline at end of file +# End: diff --git a/tests/var.test b/tests/var.test index f2a858c..8913204 100644 --- a/tests/var.test +++ b/tests/var.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: var.test,v 1.36.2.1 2010/12/11 18:39:30 kennykb Exp $ +# RCS: @(#) $Id: var.test,v 1.38 2011/01/01 15:14:43 dkf Exp $ # if {"::tcltest" ni [namespace children]} { @@ -118,9 +118,9 @@ test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of va set x:y: 789 list [set :] [set v:] [set x:y:] \ ${:} ${v:} ${x:y:} \ - [expr {[lsearch [info vars] :] != -1}] \ - [expr {[lsearch [info vars] v:] != -1}] \ - [expr {[lsearch [info vars] x:y:] != -1}] + [expr {":" in [info vars]}] \ + [expr {"v:" in [info vars]}] \ + [expr {"x:y:" in [info vars]}] } } {123 456 789 123 456 789 1 1 1} test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} { diff --git a/tests/winDde.test b/tests/winDde.test index f59a7f2..a819f93 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -9,9 +9,9 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winDde.test,v 1.28 2005/05/10 18:35:25 kennykb Exp $ +# RCS: @(#) $Id: winDde.test,v 1.29 2011/01/01 15:14:43 dkf Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { +if {"::tcltest" ni [namespace children]} { package require tcltest 2 #tcltest::configure -verbose {pass start} namespace import -force ::tcltest::* @@ -49,7 +49,7 @@ proc createChildProcess { ddeServerName {handler {}}} { puts $f { # DDE child server - # - if {[lsearch [namespace children] ::tcltest] == -1} { + if {"::tcltest" ni [namespace children]} { package require tcltest namespace import -force ::tcltest::* } @@ -267,7 +267,7 @@ test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup { dde services TclEval {} set s [dde services TclEval {}] set m [list [list TclEval dde-interp-7.5]] - if {[lsearch -exact $s $m] != -1} { + if {$m in $s} { set s } } -result {} diff --git a/tests/winPipe.test b/tests/winPipe.test index c5fb814..eeb69fa 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -9,16 +9,15 @@ # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winPipe.test,v 1.33.10.1 2010/10/09 17:53:17 kennykb Exp $ +# RCS: @(#) $Id: winPipe.test,v 1.35 2011/01/01 15:14:43 dkf Exp $ package require tcltest namespace import -force ::tcltest::* unset -nocomplain path - set bindir [file join [pwd] [file dirname [info nameofexecutable]]] set cat32 [file join $bindir cat32.exe] @@ -185,7 +184,6 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} { set result "$result$line" } } - set f [open "|[list $cat32] < $path(big) 2> $path(stderr)" r] fconfigure $f -buffering none -blocking 0 fileevent $f readable "readResults $f" @@ -237,7 +235,7 @@ test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {win exec} { set existing [glob -nocomplain c:/tcl*.tmp] exec [interpreter] < $path(nothing) foreach p [glob -nocomplain c:/tcl*.tmp] { - if {[lsearch $existing $p] == -1} { + if {$p ni $existing} { lappend x $p } } @@ -312,7 +310,6 @@ set path(echoArgs.tcl) [makeFile { puts "[list $argv0 $argv]" } echoArgs.tcl] - ### validate the raw output of BuildCommandLine(). ### test winpipe-7.1 {BuildCommandLine: null arguments} {win exec} { @@ -449,3 +446,7 @@ removeFile nothing removeFile echoArgs.tcl ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |