Author: coke
Date: Wed Jul 23 14:39:56 2008
New Revision: 29706
Modified:
trunk/languages/tcl/README.pod
trunk/languages/tcl/library/init.tcl
trunk/languages/tcl/library/tcltest/pkgIndex.tcl
trunk/languages/tcl/library/tcltest/tcltest.tcl
trunk/languages/tcl/tools/tcl_test.pl
Log:
[tcl] We are now, and have always been, targeting tcl 8.5.3.
Modified: trunk/languages/tcl/README.pod
==============================================================================
--- trunk/languages/tcl/README.pod (original)
+++ trunk/languages/tcl/README.pod Wed Jul 23 14:39:56 2008
@@ -63,7 +63,7 @@
C<[EMAIL PROTECTED]>.
To run the spec test suites, type C<make tcl-test>; This will check out
-the tests from tcl's CVS repository for the 8.5.2 release and run them.
+the tests from tcl's CVS repository for the 8.5.3 release and run them.
Note that the tests are I<fudged> slightly to use our version of [test]
As soon as we can run tcltest.tcl natively, we will.
Modified: trunk/languages/tcl/library/init.tcl
==============================================================================
--- trunk/languages/tcl/library/init.tcl (original)
+++ trunk/languages/tcl/library/init.tcl Wed Jul 23 14:39:56 2008
@@ -17,7 +17,7 @@
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or
later but the loaded version is\nonly [info patchlevel]"
}
-package require -exact Tcl 8.5a6
+package require -exact Tcl 8.5.3
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -75,31 +75,6 @@
}
}
- # Set up the 'chan' ensemble (TIP #208).
- namespace eval chan {
- # TIP #219. Added methods: create, postevent.
- # TIP 287. Added method: pending.
- namespace ensemble create -command ::chan -map {
- blocked ::tcl::chan::blocked
- close ::tcl::chan::close
- configure ::tcl::chan::configure
- copy ::tcl::chan::copy
- create ::tcl::chan::rCreate
- eof ::tcl::chan::eof
- event ::tcl::chan::event
- flush ::tcl::chan::flush
- gets ::tcl::chan::gets
- names {::file channels}
- pending ::tcl::chan::Pending
- postevent ::tcl::chan::rPostevent
- puts ::tcl::chan::puts
- read ::tcl::chan::read
- seek ::tcl::chan::seek
- tell ::tcl::chan::tell
- truncate ::tcl::chan::Truncate
- }
- }
-
# TIP #255 min and max functions
namespace eval mathfunc {
proc min {args} {
@@ -181,7 +156,7 @@
if {[interp issafe]} {
- package unknown ::tclPkgUnknown
+ package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
# Set up search for Tcl Modules (TIP #189).
# and setup platform specific unknown package handlers
@@ -404,20 +379,18 @@
"\n (expanding command prefix \"$name\" in unknown)"
return -options $opts $msg
}
- # Handle empty $name separately due to strangeness in [string first]
- if {$name eq ""} {
- if {[llength $candidates] != 1} {
- return -code error "empty command name \"\""
- }
- # It's not really possible to reach here.
- return [uplevel 1 [lreplace $args 0 0 [lindex $candidates 0]]]
- }
# Filter out bogus matches when $name contained
# a glob-special char [Bug 946952]
- set cmds [list]
- foreach x $candidates {
- if {[string first $name $x] == 0} {
- lappend cmds $x
+ if {$name eq ""} {
+ # Handle empty $name separately due to strangeness
+ # in [string first] (See RFE 1243354)
+ set cmds $candidates
+ } else {
+ set cmds [list]
+ foreach x $candidates {
+ if {[string first $name $x] == 0} {
+ lappend cmds $x
+ }
}
}
if {[llength $cmds] == 1} {
@@ -522,7 +495,7 @@
set id [gets $f]
if {$id eq "# Tcl autoload index file, version 2.0"} {
eval [read $f]
- } elseif {$id eq "# Tcl autoload index file: each line
identifies a Tcl"]} {
+ } elseif {$id eq "# Tcl autoload index file: each line
identifies a Tcl"} {
while {[gets $f line] >= 0} {
if {([string index $line 0] eq "#") \
|| ([llength $line] != 2)} {
Modified: trunk/languages/tcl/library/tcltest/pkgIndex.tcl
==============================================================================
--- trunk/languages/tcl/library/tcltest/pkgIndex.tcl (original)
+++ trunk/languages/tcl/library/tcltest/pkgIndex.tcl Wed Jul 23 14:39:56 2008
@@ -9,5 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-if {![package vsatisfies [package provide Tcl] 8.3]} {return}
-package ifneeded tcltest 2.3a1 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.3.0 [list source [file join $dir tcltest.tcl]]
Modified: trunk/languages/tcl/library/tcltest/tcltest.tcl
==============================================================================
--- trunk/languages/tcl/library/tcltest/tcltest.tcl (original)
+++ trunk/languages/tcl/library/tcltest/tcltest.tcl Wed Jul 23 14:39:56 2008
@@ -18,14 +18,13 @@
#
# RCS: @(#) $Id$
-package require Tcl 8.5 ;# To provide an alpha version
-package require Tcl 8.3 ;# uses [glob -directory]
+package require Tcl 8.5 ;# -verbose line uses [info frame]
namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
- variable Version 2.3a1
+ variable Version 2.3.0
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -1615,8 +1614,7 @@
set outData {}
set errData {}
rename ::puts [namespace current]::Replace::Puts
- namespace eval :: \
- [list namespace import [namespace origin Replace::puts]]
+ namespace eval :: [list namespace import [namespace origin
Replace::puts]]
namespace import Replace::puts
}
set result [uplevel 1 $script]
@@ -2091,13 +2089,22 @@
}
puts [outputChannel] "\n"
if {[IsVerbose line]} {
- set testFile [file normalize [uplevel 1 {info script}]]
- if {[file readable $testFile]} {
- set testFd [open $testFile r]
- set lineNo [expr {[lsearch -regexp [split [read $testFd] "\n"] \
- "^\[ \t\]*test [string map {. \\.} $name] "]+1}]
- close $testFd
- puts [outputChannel] "$testFile:$lineNo: test failed:\
+ if {![catch {set testFrame [info frame -1]}] &&
+ [dict get $testFrame type] eq "source"} {
+ set testFile [dict get $testFrame file]
+ set testLine [dict get $testFrame line]
+ } else {
+ set testFile [file normalize [uplevel 1 {info script}]]
+ if {[file readable $testFile]} {
+ set testFd [open $testFile r]
+ set testLine [expr {[lsearch -regexp \
+ [split [read $testFd] "\n"] \
+ "^\[ \t\]*test [string map {. \\.} $name] "]+1}]
+ close $testFd
+ }
+ }
+ if {[info exists testLine]} {
+ puts [outputChannel] "$testFile:$testLine: test failed:\
$name [string trim $description]"
}
}
@@ -2236,7 +2243,7 @@
if {[string match {*[$\[]*} $constraints] != 0} {
# full expression, e.g. {$foo > [info tclversion]}
catch {set doTest [uplevel #0 expr $constraints]}
- } elseif {[regexp {[^.a-zA-Z0-9 \n\r\t]+} $constraints] != 0} {
+ } elseif {[regexp {[^.:_a-zA-Z0-9 \n\r\t]+} $constraints] != 0} {
# something like {a || b} should be turned into
# $testConstraints(a) || $testConstraints(b).
regsub -all {[.\w]+} $constraints {$testConstraints(&)} c
@@ -2257,7 +2264,7 @@
}
}
- if {$doTest == 0} {
+ if {!$doTest} {
if {[IsVerbose skip]} {
puts [outputChannel] "++++ $name SKIPPED: $constraints"
}
Modified: trunk/languages/tcl/tools/tcl_test.pl
==============================================================================
--- trunk/languages/tcl/tools/tcl_test.pl (original)
+++ trunk/languages/tcl/tools/tcl_test.pl Wed Jul 23 14:39:56 2008
@@ -92,7 +92,7 @@
sub checkout_tests {
print "Checking out tests from CVS\n";
- my $tag = 'core-8-5-2'; # For the version we're targeting.
+ my $tag = 'core-8-5-3'; # For the version we're targeting.
my $command =
'cvs -z3 -d :pserver:anonymous:[EMAIL PROTECTED]:'
