summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2011-03-01 04:16:27 (GMT)
committerKevin B Kenny <kennykb@acm.org>2011-03-01 04:16:27 (GMT)
commitb153d7d08398bacf50287f086acee27748d21799 (patch)
treefe0d74fb715de8a7a2d9ae7bfd47e54e1114fc38 /tests
parent7c4049a13f83930bf6a57ef889abc9e49fa414ec (diff)
parentcd34f84f42b4e64866a9177553e91417ded252a0 (diff)
downloadtcl-b153d7d08398bacf50287f086acee27748d21799.zip
tcl-b153d7d08398bacf50287f086acee27748d21799.tar.gz
tcl-b153d7d08398bacf50287f086acee27748d21799.tar.bz2
merge trunk
Diffstat (limited to 'tests')
-rw-r--r--tests/append.test6
-rw-r--r--tests/appendComp.test6
-rw-r--r--tests/autoMkindex.test285
-rw-r--r--tests/binary.test2
-rw-r--r--tests/chanio.test4
-rw-r--r--tests/cmdAH.test82
-rw-r--r--tests/cmdIL.test5
-rw-r--r--tests/cmdMZ.test58
-rw-r--r--tests/compExpr.test215
-rw-r--r--tests/compile.test253
-rw-r--r--tests/concat.test23
-rw-r--r--tests/dict.test2
-rw-r--r--tests/error.test2
-rw-r--r--tests/eval.test23
-rw-r--r--tests/execute.test216
-rw-r--r--tests/expr.test2
-rw-r--r--tests/fCmd.test6
-rw-r--r--tests/fileName.test20
-rw-r--r--tests/fileSystem.test2
-rw-r--r--tests/http.test2
-rw-r--r--tests/info.test2
-rw-r--r--tests/interp.test10
-rw-r--r--tests/io.test4
-rw-r--r--tests/ioCmd.test8
-rw-r--r--tests/ioTrans.test8
-rw-r--r--tests/iogt.test6
-rw-r--r--tests/lsearch.test104
-rw-r--r--tests/main.test2
-rw-r--r--tests/namespace-old.test12
-rw-r--r--tests/namespace.test88
-rw-r--r--tests/oo.test18
-rw-r--r--tests/package.test1262
-rw-r--r--tests/pkg.test1222
-rw-r--r--tests/pkgMkIndex.test113
-rw-r--r--tests/proc.test357
-rw-r--r--tests/remote.tcl2
-rw-r--r--tests/safe.test2
-rw-r--r--tests/security.test16
-rw-r--r--tests/socket.test2
-rw-r--r--tests/stringComp.test2
-rw-r--r--tests/subst.test2
-rw-r--r--tests/switch.test8
-rw-r--r--tests/unixInit.test88
-rw-r--r--tests/uplevel.test6
-rw-r--r--tests/upvar.test2
-rw-r--r--tests/utf.test2
-rw-r--r--tests/util.test1963
-rw-r--r--tests/var.test8
-rw-r--r--tests/winDde.test8
-rw-r--r--tests/winPipe.test15
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: