merge trunkdkf_asm_crash_20131022

6 files changed, 23 insertions, 26 deletions

diff --git a/library/http/http.tcl b/library/http/http.tcl
index 3754f71..a6b2bfd 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
 package require Tcl 8.6
 # Keep this in sync with pkgIndex.tcl and with the install directories in
 # Makefiles
-package provide http 2.8.7
+package provide http 2.8.8
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
@@ -113,7 +113,7 @@ if {[info command http::Log] eq {}} {proc http::Log {args} {}}
 
 proc http::register {proto port command} {
     variable urlTypes
-    set urlTypes($proto) [list $port $command]
+    set urlTypes([string tolower $proto]) [list $port $command]
 }
 
 # http::unregister --
@@ -127,11 +127,12 @@ proc http::register {proto port command} {
 
 proc http::unregister {proto} {
     variable urlTypes
-    if {![info exists urlTypes($proto)]} {
+    set lower [string tolower $proto]
+    if {![info exists urlTypes($lower)]} {
 	return -code error "unsupported url type \"$proto\""
     }
-    set old $urlTypes($proto)
-    unset urlTypes($proto)
+    set old $urlTypes($lower)
+    unset urlTypes($lower)
     return $old
 }
 
@@ -514,12 +515,13 @@ proc http::geturl {url args} {
     if {$proto eq ""} {
 	set proto http
     }
-    if {![info exists urlTypes($proto)]} {
+    set lower [string tolower $proto]
+    if {![info exists urlTypes($lower)]} {
 	unset $token
 	return -code error "Unsupported URL type \"$proto\""
     }
-    set defport [lindex $urlTypes($proto) 0]
-    set defcmd [lindex $urlTypes($proto) 1]
+    set defport [lindex $urlTypes($lower) 0]
+    set defcmd [lindex $urlTypes($lower) 1]
 
     if {$port eq ""} {
 	set port $defport
@@ -650,7 +652,8 @@ proc http::Connected { token proto phost srvurl} {
     set host [lindex [split $state(socketinfo) :] 0]
     set port [lindex [split $state(socketinfo) :] 1]
 
-    set defport [lindex $urlTypes($proto) 0]
+    set lower [string tolower $proto]
+    set defport [lindex $urlTypes($lower) 0]
 
     # Send data in cr-lf format, but accept any line terminators
 
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index aaa3e85..27ba795 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,2 +1,2 @@
 if {![package vsatisfies [package provide Tcl] 8.6]} {return}
-package ifneeded http 2.8.7 [list tclPkgSetup $dir http 2.8.7 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.8.8 [list tclPkgSetup $dir http 2.8.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/library/init.tcl b/library/init.tcl
index 1ca6413..f63eedf 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -130,9 +130,9 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
 		    switch -- $u {
 			COMSPEC -
 			PATH {
-			    if {![info exists env($u)]} {
-				set env($u) $env($p)
-			    }
+			    set temp $env($p)
+			    unset env($p)
+			    set env($u) $temp
 			    trace add variable env($p) write \
 				    [namespace code [list EnvTraceProc $p]]
 			    trace add variable env($u) write \
@@ -142,11 +142,7 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
 		}
 	    }
 	    if {![info exists env(COMSPEC)]} {
-		if {$tcl_platform(os) eq "Windows NT"} {
-		    set env(COMSPEC) cmd.exe
-		} else {
-		    set env(COMSPEC) command.com
-		}
+		set env(COMSPEC) cmd.exe
 	    }
 	}
 	InitWinEnv
diff --git a/library/parray.tcl b/library/parray.tcl
index 3ce9817..a9c2cb1 100644
--- a/library/parray.tcl
+++ b/library/parray.tcl
@@ -11,7 +11,7 @@
 proc parray {a {pattern *}} {
     upvar 1 $a array
     if {![array exists array]} {
-	error "\"$a\" isn't an array"
+	return -code error "\"$a\" isn't an array"
     }
     set maxl 0
     set names [lsort [array names array $pattern]]
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index 60a9485..c99ad2a 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -9,4 +9,4 @@
 # full path name of this file's directory.
 
 if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded tcltest 2.3.6 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.3.7 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index c30d2e4..4b94312 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,7 @@ 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.3.6
+    variable Version 2.3.7
 
     # Compatibility support for dumb variables defined in tcltest 1
     # Do not use these.  Call [package provide Tcl] and [info patchlevel]
@@ -2498,17 +2498,15 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} {
 	    if {![info exists originalEnv($index)]} {
 		lappend newEnv $index
 		unset ::env($index)
-	    } else {
-		if {$::env($index) != $originalEnv($index)} {
-		    lappend changedEnv $index
-		    set ::env($index) $originalEnv($index)
-		}
 	    }
 	}
 	foreach index [array names originalEnv] {
 	    if {![info exists ::env($index)]} {
 		lappend removedEnv $index
 		set ::env($index) $originalEnv($index)
+	    } elseif {$::env($index) ne $originalEnv($index)} {
+		lappend changedEnv $index
+		set ::env($index) $originalEnv($index)
 	    }
 	}
 	if {[llength $newEnv] > 0} {