Merge 9.0

11 files changed, 129 insertions, 114 deletions

diff --git a/library/auto.tcl b/library/auto.tcl
index 2eacf8c..dc37328 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -70,60 +70,70 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
 	#    gives the end-user ultimate control to work-around any bugs, or
 	#    to customize.
 
-        if {[info exists env($enVarName)]} {
-            lappend dirs $env($enVarName)
-        }
+	if {[info exists env($enVarName)]} {
+	    lappend dirs $env($enVarName)
+	}
 
 	catch {
-      set found 0
+	    set found 0
 	    set root [zipfs root]
-	    set mountpoint [file join $root lib [string tolower $basename]]
-      lappend dirs [file join $root app ${basename}_library]
-      lappend dirs [file join $root lib $mountpoint ${basename}_library]
-      lappend dirs [file join $root lib $mountpoint]
+	    set mountpoint [file join $root lib $basename]
+	    lappend dirs [file join $root app ${basename}_library]
+	    lappend dirs [file join $root lib $mountpoint ${basename}_library]
+	    lappend dirs [file join $root lib $mountpoint]
 	    if {![zipfs exists [file join $root app ${basename}_library]] \
-	      && ![zipfs exists $mountpoint]} {
-	      set found 0
-	      foreach pkgdat [info loaded] {
-	        lassign $pkgdat dllfile dllpkg
-	        if {[string tolower $dllpkg] ne [string tolower $basename]} continue
-	        if {$dllfile eq {}} {
-	          # Loaded statically
-	          break
-	        }
-          set found 1
-	        zipfs mount $mountpoint $dllfile
-	        break
-	      }
-	      if {!$found} {
-  	      set paths {}
-  	      lappend paths [file join $root app]
-    	    lappend paths [::${basename}::pkgconfig get libdir,runtime]
-	        lappend paths [::${basename}::pkgconfig get bindir,runtime]
-	        if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} {
-  	        set zipfile [string tolower \
-  	          "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
-  	      }
-  	      lappend paths [file dirname [file join [pwd] [info nameofexecutable]]]
-          foreach path $paths {
-            set archive [file join $path $zipfile]
-            if {![file exists $archive]} continue
-            zipfs mount $mountpoint $archive
-            if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
-              lappend dirs [file join $mountpoint ${basename}_library]
-              set found 1
-              break
-            } elseif {[zipfs exists [file join $mountpoint $initScript]]} {
-              lappend dirs [file join $mountpoint $initScript]
-              set found 1
-              break
-            } else {
-              catch {zipfs unmount $archive}
-            }
-          }
-        }
-      }
-   }
+		    && ![zipfs exists $mountpoint]} {
+		set found 0
+		foreach pkgdat [info loaded] {
+		    lassign $pkgdat dllfile dllpkg
+		    if {$dllpkg ne $basename} continue
+		    if {$dllfile eq {}} {
+			# Loaded statically
+			break
+		    }
+		    set found 1
+		    zipfs mount $mountpoint $dllfile
+		    break
+		}
+		if {!$found} {
+		    set paths {}
+		    if {![catch {::${basename}::pkgconfig get libdir,runtime} dir]} {
+			lappend paths $dir
+		    } else {
+			catch {lappend paths [::tcl::pkgconfig get libdir,runtime]}
+		    }
+		    if {![catch {::${basename}::pkgconfig get bindir,runtime} dir]} {
+			lappend paths $dir
+		    } else {
+			catch {lappend paths [::tcl::pkgconfig get bindir,runtime]}
+		    }
+		    if {[catch {::${basename}::pkgconfig get dllfile,runtime} dllfile]} {
+			set dllfile "lib${basename}${version}[info sharedlibextension]"
+		    }
+		    set dir [file dirname [file join [pwd] [info nameofexecutable]]]
+		    lappend paths $dir
+		    lappend paths [file join [file dirname $dir] lib]
+		    foreach path $paths {
+			set archive [file join $path $dllfile]
+			if {![file exists $archive]} {
+			    continue
+			}
+			zipfs mount $mountpoint $archive
+			if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
+			    lappend dirs [file join $mountpoint ${basename}_library]
+			    set found 1
+			    break
+			} elseif {[zipfs exists [file join $mountpoint $initScript]]} {
+			    lappend dirs [file join $mountpoint $initScript]
+			    set found 1
+			    break
+			} else {
+			    catch {zipfs unmount $archive}
+			}
+	      	    }
+		}
+	    }
+	}
 
 	# 2. In the package script directory registered within the
 	#    configuration of the package itself.
@@ -158,11 +168,11 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
 	# ../../../foo1.0.1/library
 	#		(From unix/arch directory in parallel build hierarchy)
 
-        set parentDir [file dirname [file dirname [info nameofexecutable]]]
-        set grandParentDir [file dirname $parentDir]
-        lappend dirs [file join $parentDir lib $basename$version]
-        lappend dirs [file join $grandParentDir lib $basename$version]
-        lappend dirs [file join $parentDir library]
+	set parentDir [file dirname [file dirname [info nameofexecutable]]]
+	set grandParentDir [file dirname $parentDir]
+	lappend dirs [file join $parentDir lib $basename$version]
+	lappend dirs [file join $grandParentDir lib $basename$version]
+	lappend dirs [file join $parentDir library]
 	if {0} {
 	    lappend dirs [file join $grandParentDir library]
 	    lappend dirs [file join $grandParentDir $basename$patch library]
@@ -185,19 +195,19 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
 	}
 	set seen($norm) {}
 
-        set the_library $i
-        set file [file join $i $initScript]
+	set the_library $i
+	set file [file join $i $initScript]
 
 	# source everything when in a safe interpreter because we have a
 	# source command, but no file exists command
 
-        if {[interp issafe] || [file exists $file]} {
-            if {![catch {uplevel #0 [list source $file]} msg opts]} {
-                return
-            }
+	if {[interp issafe] || [file exists $file]} {
+	    if {![catch {uplevel #0 [list source $file]} msg opts]} {
+		return
+	    }
 	    append errors "$file: $msg\n"
 	    append errors [dict get $opts -errorinfo]\n
-        }
+	}
     }
     unset -nocomplain the_library
     set msg "Can't find a usable $initScript in the following directories: \n"
@@ -236,7 +246,7 @@ if {[interp issafe]} {
 
 proc auto_mkindex {dir args} {
     if {[interp issafe]} {
-        error "can't generate index within safe interpreter"
+	error "can't generate index within safe interpreter"
     }
 
     set oldDir [pwd]
@@ -292,7 +302,7 @@ proc auto_mkindex_old {dir args} {
 	set f ""
 	set error [catch {
 	    set f [open $file]
-	    fconfigure $f -encoding utf-8 -eofchar \032
+	    fconfigure $f -encoding utf-8 -eofchar "\032 {}"
 	    while {[gets $f line] >= 0} {
 		if {[regexp {^proc[ 	]+([^ 	]*)} $line match procName]} {
 		    set procName [lindex [auto_qualify $procName "::"] 0]
@@ -404,7 +414,7 @@ proc auto_mkindex_parser::mkindex {file} {
     set scriptFile $file
 
     set fid [open $file]
-    fconfigure $fid -encoding utf-8 -eofchar \032
+    fconfigure $fid -encoding utf-8 -eofchar "\032 {}"
     set contents [read $fid]
     close $fid
 
@@ -424,7 +434,7 @@ proc auto_mkindex_parser::mkindex {file} {
     $parser eval $contents
 
     foreach name $imports {
-        catch {$parser eval [list _%@namespace forget $name]}
+	catch {$parser eval [list _%@namespace forget $name]}
     }
     return $index
 }
@@ -494,9 +504,9 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
     set ns [namespace qualifiers $name]
     set tail [namespace tail $name]
     if {$ns eq ""} {
-        set fakeName [namespace current]::_%@fake_$tail
+	set fakeName [namespace current]::_%@fake_$tail
     } else {
-        set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
+	set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
     }
     proc $fakeName $arglist $body
 
@@ -505,8 +515,8 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
     # the fully qualified names, and have the procs point to the aliases.
 
     if {[string match *::* $name]} {
-        set exportCmd [list _%@namespace export [namespace tail $name]]
-        $parser eval [list _%@namespace eval $ns $exportCmd]
+	set exportCmd [list _%@namespace export [namespace tail $name]]
+	$parser eval [list _%@namespace eval $ns $exportCmd]
 
 	# The following proc definition does not work if you want to tolerate
 	# space or something else diabolical in the procedure name, (i.e.,
@@ -518,11 +528,11 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
 	# A gold star to someone that can make test autoMkindex-3.3 work
 	# properly
 
-        set alias [namespace tail $fakeName]
-        $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
-        $parser alias $alias $fakeName
+	set alias [namespace tail $fakeName]
+	$parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
+	$parser alias $alias $fakeName
     } else {
-        $parser alias $name $fakeName
+	$parser alias $name $fakeName
     }
     return
 }
@@ -544,18 +554,18 @@ proc auto_mkindex_parser::fullname {name} {
     variable contextStack
 
     if {![string match ::* $name]} {
-        foreach ns $contextStack {
-            set name "${ns}::$name"
-            if {[string match ::* $name]} {
-                break
-            }
-        }
+	foreach ns $contextStack {
+	    set name "${ns}::$name"
+	    if {[string match ::* $name]} {
+		break
+	    }
+	}
     }
 
     if {[namespace qualifiers $name] eq ""} {
-        set name [namespace tail $name]
+	set name [namespace tail $name]
     } elseif {![string match ::* $name]} {
-        set name "::$name"
+	set name "::$name"
     }
 
     # Earlier, mkindex replaced all $'s with \0.  Now, we have to reverse that
@@ -645,27 +655,27 @@ auto_mkindex_parser::hook {
 
 auto_mkindex_parser::command namespace {op args} {
     switch -- $op {
-        eval {
-            variable parser
-            variable contextStack
+	eval {
+	    variable parser
+	    variable contextStack
 
-            set name [lindex $args 0]
-            set args [lrange $args 1 end]
+	    set name [lindex $args 0]
+	    set args [lrange $args 1 end]
 
-            set contextStack [linsert $contextStack 0 $name]
+	    set contextStack [linsert $contextStack 0 $name]
 	    $parser eval [list _%@namespace eval $name] $args
-            set contextStack [lrange $contextStack 1 end]
-        }
-        import {
-            variable parser
-            variable imports
-            foreach pattern $args {
-                if {$pattern ne "-force"} {
-                    lappend imports $pattern
-                }
-            }
-            catch {$parser eval "_%@namespace import $args"}
-        }
+	    set contextStack [lrange $contextStack 1 end]
+	}
+	import {
+	    variable parser
+	    variable imports
+	    foreach pattern $args {
+		if {$pattern ne "-force"} {
+		    lappend imports $pattern
+		}
+	    }
+	    catch {$parser eval "_%@namespace import $args"}
+	}
 	ensemble {
 	    variable parser
 	    variable contextStack
diff --git a/library/init.tcl b/library/init.tcl
index 14b2d68..dbfaaa7 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -442,7 +442,7 @@ proc auto_load_index {} {
 	    continue
 	} else {
 	    set error [catch {
-		fconfigure $f -encoding utf-8 -eofchar \032
+		fconfigure $f -encoding utf-8 -eofchar "\032 {}"
 		set id [gets $f]
 		if {$id eq "# Tcl autoload index file, version 2.0"} {
 		    eval [read $f]
diff --git a/library/install.tcl b/library/install.tcl
index 2c5afa7..ce8e80b 100644
--- a/library/install.tcl
+++ b/library/install.tcl
@@ -35,7 +35,7 @@ proc ::practcl::_pkgindex_directory {path} {
       # Read the file, and override assumptions as needed
       ###
       set fin [open $file r]
-      fconfigure $fin -encoding utf-8 -eofchar \032
+      fconfigure $fin -encoding utf-8 -eofchar "\032 {}"
       set dat [read $fin]
       close $fin
       # Look for a teapot style Package statement
@@ -59,7 +59,7 @@ proc ::practcl::_pkgindex_directory {path} {
     foreach file [glob -nocomplain $path/*.tcl] {
       if { [file tail $file] == "version_info.tcl" } continue
       set fin [open $file r]
-      fconfigure $fin -encoding utf-8 -eofchar \032
+      fconfigure $fin -encoding utf-8 -eofchar "\032 {}"
       set dat [read $fin]
       close $fin
       if {![regexp "package provide" $dat]} continue
@@ -79,7 +79,7 @@ proc ::practcl::_pkgindex_directory {path} {
     return $buffer
   }
   set fin [open $pkgidxfile r]
-  fconfigure $fin -encoding utf-8 -eofchar \032
+  fconfigure $fin -encoding utf-8 -eofchar "\032 {}"
   set dat [read $fin]
   close $fin
   set trace 0
diff --git a/library/manifest.txt b/library/manifest.txt
index 0a516b1..08529da 100644
--- a/library/manifest.txt
+++ b/library/manifest.txt
@@ -10,7 +10,7 @@ apply {{dir} {
     1 opt             0.4.8  {opt optparse.tcl}
     0 cookiejar       0.2.0  {cookiejar cookiejar.tcl}
     0 tcl::idna       1.0.1  {cookiejar idna.tcl}
-    0 platform        1.0.16 {platform platform.tcl}
+    0 platform        1.0.17 {platform platform.tcl}
     0 platform::shell 1.1.4  {platform shell.tcl}
     1 tcltest         2.5.4  {tcltest tcltest.tcl}
   } {
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index 1639379..454b923 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -601,7 +601,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
 	    return [expr {$arg ? 1 : 0}]
         }
         choice {
-            if {[lsearch -exact $typeArgs $arg] < 0} {
+            if {$arg ni $typeArgs} {
                 error "invalid choice"
             }
 	    return $arg
diff --git a/library/platform/pkgIndex.tcl b/library/platform/pkgIndex.tcl
index 401300a..7983831 100644
--- a/library/platform/pkgIndex.tcl
+++ b/library/platform/pkgIndex.tcl
@@ -1,3 +1,3 @@
-package ifneeded platform        1.0.16 [list source [file join $dir platform.tcl]]
+package ifneeded platform        1.0.17 [list source [file join $dir platform.tcl]]
 package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]]
 
diff --git a/library/platform/platform.tcl b/library/platform/platform.tcl
index 2c83102..e01334e 100644
--- a/library/platform/platform.tcl
+++ b/library/platform/platform.tcl
@@ -29,8 +29,10 @@
 # are on "Windows NT" or "Windows XP" or whatever.
 #
 # Machine specific
+# % amd64  -> x86_64
 # % arm*   -> arm
 # % sun4*  -> sparc
+# % ia32*  -> ix86
 # % intel  -> ix86
 # % i*86*  -> ix86
 # % Power* -> powerpc
@@ -81,6 +83,7 @@ proc ::platform::generic {} {
 		set cpu ix86
 	    }
 	}
+	ppc -
 	"Power*" {
 	    set cpu powerpc
 	}
@@ -177,8 +180,9 @@ proc ::platform::identify {} {
 	macosx {
 	    set major [lindex [split $tcl_platform(osVersion) .] 0]
 	    if {$major > 19} {
-		incr major -20
-		append plat 11.$major
+		set minor [lindex [split $tcl_platform(osVersion) .] 1]
+		incr major -9
+		append plat $major.[expr {$minor - 1}]
 	    } else {
 		incr major -4
 		append plat 10.$major
@@ -405,7 +409,7 @@ proc ::platform::patterns {id} {
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide platform 1.0.16
+package provide platform 1.0.17
 
 # ### ### ### ######### ######### #########
 ## Demo application
diff --git a/library/safe.tcl b/library/safe.tcl
index 9f2d007..b6e23ab 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -980,7 +980,7 @@ proc ::safe::AliasSource {child args} {
     set replacementMsg "script error"
     set code [catch {
 	set f [open $realfile]
-	fconfigure $f -encoding $encoding -eofchar \032
+	fconfigure $f -encoding $encoding -eofchar "\032 {}"
 	set contents [read $f]
 	close $f
 	::interp eval $child [list info script $file]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 3c58782..eb47963 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -648,7 +648,7 @@ namespace eval tcltest {
 
     proc IsVerbose {level} {
 	variable Option
-	return [expr {[lsearch -exact $Option(-verbose) $level] >= 0}]
+	return [expr {$level in $Option(-verbose)}]
     }
 
     # Default verbosity is to show bodies of failed tests
diff --git a/library/tm.tcl b/library/tm.tcl
index 3c0ec22..c1a8f8a 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -316,7 +316,7 @@ proc ::tcl::tm::UnknownHandler {original name args} {
 proc ::tcl::tm::Defaults {} {
     global env tcl_platform
 
-    regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
+    regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor
     set exe [file normalize [info nameofexecutable]]
 
     # Note that we're using [::list], not [list] because [list] means
@@ -359,7 +359,7 @@ proc ::tcl::tm::Defaults {} {
 #	Calls 'path add' to paths to the list of module search paths.
 
 proc ::tcl::tm::roots {paths} {
-    regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
+    regexp {^(\d+)\.(\d+)} [package provide tcl] - major minor
     foreach pa $paths {
 	set p [file join $pa tcl$major]
 	for {set n $minor} {$n >= 0} {incr n -1} {
diff --git a/library/tzdata/Africa/Juba b/library/tzdata/Africa/Juba
index a0dbf5e..043d95f 100644
--- a/library/tzdata/Africa/Juba
+++ b/library/tzdata/Africa/Juba
@@ -36,4 +36,5 @@ set TZData(:Africa/Juba) {
     {483487200 10800 1 CAST}
     {498171600 7200 0 CAT}
     {947930400 10800 0 EAT}
+    {1612126800 7200 0 CAT}
 }