plugin updates

FossilOrigin-Name: 594ce53543ab0e1e09fe7eabec3e198a06256812

13 files changed, 216 insertions, 198 deletions

diff --git a/changes b/changes
index 3220a60..62251c9 100644
--- a/changes
+++ b/changes
@@ -3452,6 +3452,35 @@ Universal Headers V.3.0, so that Tcl will compile with CW Pro 2.
 
 ----------------- Released 8.0p2, 11/25/97 -----------------------
 
+12/3/97 (bug fix/optimization) Removed uneeded and potentially dangerous
+instances of double evaluations if "if" and "expr" statements from
+the library files. It is recommended that unless you need a double
+evaluation you always use "expr {...}" instead of "expr ..." and
+"if {...} ..." instead of "if ... ...". It will also be faster
+thanks to the byte compiler. (DL)
+
+---- Shipped as part of the plugin2.0b5 as 8.0p2Plugin1, Dec 8th 97 ----
+
+12/8/97 (bug fix) Need to protect the newly accepted channel in an
+accept callback on a socket, otherwise the callback may close it and
+cause an error, which would cause the C code to attempt to close the
+now deleted channel. Bumping the refcount assures that the channel sticks
+around to be really closed in this case. (JL)
+
+12/8/97 (bug fix) Need to protect the channel in a fileevent so that it
+is not deleted before the fileevent handler returns. (CS, JL)
+
+12/18/97 (bug fix) In the opt argument parsing package: if the description 
+had only flags, the "too many arguments" case was not detected. The default
+value was not used for the special "args" ending argument. (DL)
+
+1/15/98 (improvement) Moved common part of initScript in common file.
+Moved windows specific initialization to init.tcl so you can initialize
+Tcl in windows without having to call Tcl_Init which is now only
+searching for init.tcl {back ported from 8.1}. (DL)
+
+---- Shipped as part of the plugin as 8.0p2Plugin2, Jan 15th 98 ----
+
 5/27/98 (bug fix) Windows socket driver did not notice new data arriving
 on nonblocking sockets until the event loop was entered. (SS)
 
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 534060b..f198474 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -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.
  *
- * SCCS: %Z% $Id: tclIO.c,v 1.2 1998/06/09 13:08:16 stanton Exp $ 
+ * SCCS: %Z% $Id: tclIO.c,v 1.3 1998/06/27 18:10:15 welch Exp $ 
  */
 
 #include	"tclInt.h"
@@ -4519,7 +4519,14 @@ Tcl_NotifyChannel(channel, mask)
     ChannelHandler *chPtr;
     NextChannelHandler nh;
 
-    Tcl_Preserve((ClientData)chanPtr);
+    /*
+     * Prevent the event handler from deleting the channel by incrementing
+     * the channel's ref count.  Case in point: ChannelEventScriptInvoker()
+     * was evaling a script (owned by the channel) which caused the channel
+     * to be closed and then the byte codes no longer existed.
+     */
+     
+    Tcl_RegisterChannel((Tcl_Interp *) NULL, channel);
 
     /*
      * If we are flushing in the background, be sure to call FlushChannel
@@ -4566,7 +4573,13 @@ Tcl_NotifyChannel(channel, mask)
     if (chanPtr->typePtr != NULL) {
 	UpdateInterest(chanPtr);
     }
-    Tcl_Release((ClientData)chanPtr);
+
+    /*
+     * No longer need to protect the channel from being deleted.
+     * After this point it is unsafe to use the value of "channel".
+     */
+ 
+    Tcl_UnregisterChannel((Tcl_Interp *) NULL, channel);
 
     nestedHandlerPtr = nh.nestedHandlerPtr;
 }
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 5640b47..88a299a 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -1238,12 +1238,28 @@ AcceptCallbackProc(callbackData, chan, address, port)
 
 	TclFormatInt(portBuf, port);
         Tcl_RegisterChannel(interp, chan);
+
+        /*
+         * Artificially bump the refcount to protect the channel from
+         * being deleted while the script is being evaluated.
+         */
+
+        Tcl_RegisterChannel((Tcl_Interp *) NULL,  chan);
+        
         result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
                 " ", address, " ", portBuf, (char *) NULL);
         if (result != TCL_OK) {
             Tcl_BackgroundError(interp);
 	    Tcl_UnregisterChannel(interp, chan);
         }
+
+        /*
+         * Decrement the artificially bumped refcount. After this it is
+         * not safe anymore to use "chan", because it may now be deleted.
+         */
+
+        Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan);
+        
         Tcl_Release((ClientData) interp);
         Tcl_Release((ClientData) script);
     } else {
diff --git a/library/history.tcl b/library/history.tcl
index a6beb43..f1516f3 100644
--- a/library/history.tcl
+++ b/library/history.tcl
@@ -19,7 +19,7 @@
 
 namespace eval tcl {
     variable history
-    if ![info exists history] {
+    if {![info exists history]} {
 	array set history {
 	    nextid	0
 	    keep	20
@@ -118,7 +118,7 @@ proc history {args} {
 		return [tcl::HistKeep]
 	    } else {
 		set limit [lindex $args 1]
-		if {[catch {expr $limit}] || ($limit < 0)} {
+		if {[catch {expr {~$limit}}] || ($limit < 0)} {
 		    return -code error "illegal keep count \"$limit\""
 		}
 		return [tcl::HistKeep $limit]
@@ -132,7 +132,7 @@ proc history {args} {
 	    if {![string match $key* nextid]} {
 		return -code error "bad option \"$key\": must be $options"
 	    }
-	    return [expr $tcl::history(nextid) + 1]
+	    return [expr {$tcl::history(nextid) + 1}]
 	}
 	r* { # history redo
 
@@ -196,7 +196,7 @@ proc history {args} {
 	return $history(keep)
     } else {
 	set oldold $history(oldest)
-	set history(oldest) [expr $history(nextid) - $limit]
+	set history(oldest) [expr {$history(nextid) - $limit}]
 	for {} {$oldold <= $history(oldest)} {incr oldold} {
 	    if {[info exists history($oldold)]} {unset history($oldold)}
 	}
@@ -241,13 +241,13 @@ proc history {args} {
  proc tcl::HistInfo {{num {}}} {
     variable history
     if {$num == {}} {
-	set num [expr $history(keep) + 1]
+	set num [expr {$history(keep) + 1}]
     }
     set result {}
     set newline ""
-    for {set i [expr $history(nextid) - $num + 1]} \
+    for {set i [expr {$history(nextid) - $num + 1}]} \
 	    {$i <= $history(nextid)} {incr i} {
-	if ![info exists history($i)] {
+	if {![info exists history($i)]} {
 	    continue
 	}
 	set cmd [string trimright $history($i) \ \n]
@@ -304,7 +304,7 @@ proc history {args} {
 
  proc tcl::HistIndex {event} {
     variable history
-    if {[catch {expr $event}]} {
+    if {[catch {expr {~$event}}]} {
 	for {set i $history(nextid)} {[info exists history($i)]} {incr i -1} {
 	    if {[string match $event* $history($i)]} {
 		return $i;
@@ -315,7 +315,7 @@ proc history {args} {
 	}
 	return -code error "no event matches \"$event\""
     } elseif {$event <= 0} {
-	set i [expr $history(nextid) + $event]
+	set i [expr {$history(nextid) + $event}]
     } else {
 	set i $event
     }
diff --git a/library/init.tcl b/library/init.tcl
index ebf1913..76cec74 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# SCCS: @(#) init.tcl 1.95 97/11/19 17:16:34
+# SCCS: %Z% $Id: init.tcl,v 1.2 1998/06/27 18:11:24 welch Exp $ 
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -21,7 +21,7 @@ package require -exact Tcl 8.0
 # (auto_path could be already set, in safe interps for instance)
 
 if {![info exists auto_path]} {
-    if [catch {set auto_path $env(TCLLIBPATH)}] {
+    if {[catch {set auto_path $env(TCLLIBPATH)}]} {
 	set auto_path ""
     }
 }
@@ -37,6 +37,41 @@ catch {
     unset __dir
 }
 
+# Windows specific end of initialization
+
+if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
+    namespace eval tcl {
+	proc envTraceProc {lo n1 n2 op} {
+	    set x $::env($n2)
+	    set ::env($lo) $x
+	    set ::env([string toupper $lo]) $x
+	}
+    }
+    foreach p [array names env] {
+	set u [string toupper $p]
+	if {$u != $p} {
+	    switch -- $u {
+		COMSPEC -
+		PATH {
+		    if {![info exists env($u)]} {
+			set env($u) $env($p)
+		    }
+		    trace variable env($p) w [list tcl::envTraceProc $p]
+		    trace variable env($u) w [list tcl::envTraceProc $p]
+		}
+	    }
+	}
+    }
+    if {![info exists env(COMSPEC)]} {
+	if {$tcl_platform(os) == {Windows NT}} {
+	    set env(COMSPEC) cmd.exe
+	} else {
+	    set env(COMSPEC) command.com
+	}
+    }
+}
+
+
 # Setup the unknown package handler
 
 package unknown tclPkgUnknown
@@ -98,11 +133,11 @@ if {[info commands tclLog] == ""} {
     set savedErrorCode $errorCode
     set savedErrorInfo $errorInfo
     set name [lindex $args 0]
-    if ![info exists auto_noload] {
+    if {![info exists auto_noload]} {
 	#
 	# Make sure we're not trying to load the same proc twice.
 	#
-	if [info exists unknown_pending($name)] {
+	if {[info exists unknown_pending($name)]} {
 	    return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
 	}
 	set unknown_pending($name) pending;
@@ -112,10 +147,10 @@ if {[info commands tclLog] == ""} {
 	    return -code $ret -errorcode $errorCode \
 		"error while autoloading \"$name\": $msg"
 	}
-	if ![array size unknown_pending] {
+	if {![array size unknown_pending]} {
 	    unset unknown_pending
 	}
-	if $msg {
+	if {$msg} {
 	    set errorCode $savedErrorCode
 	    set errorInfo $savedErrorInfo
 	    set code [catch {uplevel 1 $args} msg]
@@ -126,7 +161,7 @@ if {[info commands tclLog] == ""} {
 		#
 
 		set new [split $errorInfo \n]
-		set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
+		set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
 		return -code error -errorcode $errorCode \
 			-errorinfo $new $msg
 	    } else {
@@ -137,7 +172,7 @@ if {[info commands tclLog] == ""} {
 
     if {([info level] == 1) && ([info script] == "") \
 	    && [info exists tcl_interactive] && $tcl_interactive} {
-	if ![info exists auto_noexec] {
+	if {![info exists auto_noexec]} {
 	    set new [auto_execok $name]
 	    if {$new != ""} {
 		set errorCode $savedErrorCode
@@ -159,7 +194,7 @@ if {[info commands tclLog] == ""} {
 	    set newcmd [history event -1]
 	    catch {regsub -all -- $old $newcmd $new newcmd}
 	}
-	if [info exists newcmd] {
+	if {[info exists newcmd]} {
 	    tclLog $newcmd
 	    history change $newcmd 0
 	    return [uplevel $newcmd]
@@ -211,15 +246,15 @@ if {[info commands tclLog] == ""} {
     # from older auto_mkindex versions
     lappend nameList $cmd
     foreach name $nameList {
-	if [info exists auto_index($name)] {
+	if {[info exists auto_index($name)]} {
 	    uplevel #0 $auto_index($name)
 	    return [expr {[info commands $name] != ""}]
 	}
     }
-    if ![info exists auto_path] {
+    if {![info exists auto_path]} {
 	return 0
     }
-    if [info exists auto_oldpath] {
+    if {[info exists auto_oldpath]} {
 	if {$auto_oldpath == $auto_path} {
 	    return 0
 	}
@@ -230,12 +265,12 @@ if {[info commands tclLog] == ""} {
     # newer format tclIndex files.
 
     set issafe [interp issafe]
-    for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {
+    for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
 	set dir [lindex $auto_path $i]
 	set f ""
 	if {$issafe} {
 	    catch {source [file join $dir tclIndex]}
-	} elseif [catch {set f [open [file join $dir tclIndex]]}] {
+	} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
 	    continue
 	} else {
 	    set error [catch {
@@ -261,13 +296,13 @@ if {[info commands tclLog] == ""} {
 	    if {$f != ""} {
 		close $f
 	    }
-	    if $error {
+	    if {$error} {
 		error $msg $errorInfo $errorCode
 	    }
 	}
     }
     foreach name $nameList {
-	if [info exists auto_index($name)] {
+	if {[info exists auto_index($name)]} {
 	    uplevel #0 $auto_index($name)
 	    if {[info commands $name] != ""} {
 		return 1
@@ -359,7 +394,7 @@ if {[string compare $tcl_platform(platform) windows] == 0} {
 proc auto_execok name {
     global auto_execs env tcl_platform
 
-    if [info exists auto_execs($name)] {
+    if {[info exists auto_execs($name)]} {
 	return $auto_execs($name)
     }
     set auto_execs($name) ""
@@ -425,7 +460,7 @@ proc auto_execok name {
 proc auto_execok name {
     global auto_execs env
 
-    if [info exists auto_execs($name)] {
+    if {[info exists auto_execs($name)]} {
 	return $auto_execs($name)
     }
     set auto_execs($name) ""
@@ -506,7 +541,7 @@ proc auto_mkindex {dir args} {
 	set error [catch {
 	    set f [open $file]
 	    while {[gets $f line] >= 0} {
-		if [regexp {^proc[ 	]+([^ 	]*)} $line match procName] {
+		if {[regexp {^proc[ 	]+([^ 	]*)} $line match procName]} {
 		    set procName [lindex [auto_qualify $procName "::"] 0]
 		    append index "set [list auto_index($procName)]"
 		    append index " \[list source \[file join \$dir [list $file]\]\]\n"
@@ -514,7 +549,7 @@ proc auto_mkindex {dir args} {
 	    }
 	    close $f
 	} msg]
-	if $error {
+	if {$error} {
 	    set code $errorCode
 	    set info $errorInfo
 	    catch {close $f}
@@ -529,7 +564,7 @@ proc auto_mkindex {dir args} {
 	close $f
 	cd $oldDir
     } msg]
-    if $error {
+    if {$error} {
 	set code $errorCode
 	set info $errorInfo
 	catch {close $f}
@@ -589,7 +624,7 @@ proc pkg_mkIndex {dir args} {
 	    }
 	}
 	$c eval [list set file $file]
-	if [catch {
+	if {[catch {
 	    $c eval {
 		proc dummy args {}
 		rename package package-orig
@@ -657,7 +692,7 @@ proc pkg_mkIndex {dir args} {
 		    }
 		}
 	    }
-	} msg] {
+	} msg]} {
 	    tclLog "error while loading or sourcing $file: $msg"
 	}
 	foreach pkg [$c eval set pkgs] {
@@ -719,7 +754,7 @@ proc tclPkgSetup {dir pkg version files} {
 
 proc tclMacPkgSearch {dir} {
     foreach x [glob -nocomplain [file join $dir *.shlb]] {
-	if [file isfile $x] {
+	if {[file isfile $x]} {
 	    set res [resource open $x]
 	    foreach y [resource list TEXT $res] {
 		if {$y == "pkgIndex"} {source -rsrc pkgIndex}
@@ -745,17 +780,17 @@ proc tclMacPkgSearch {dir} {
 proc tclPkgUnknown {name version {exact {}}} {
     global auto_path tcl_platform env
 
-    if ![info exists auto_path] {
+    if {![info exists auto_path]} {
 	return
     }
-    for {set i [expr [llength $auto_path] - 1]} {$i >= 0} {incr i -1} {
+    for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
 	# we can't use glob in safe interps, so enclose the following
 	# in a catch statement
 	catch {
 	    foreach file [glob -nocomplain [file join [lindex $auto_path $i] \
 		    * pkgIndex.tcl]] {
 		set dir [file dirname $file]
-		if [catch {source $file} msg] {
+		if {[catch {source $file} msg]} {
 		    tclLog "error reading package index file $file: $msg"
 		}
 	    }
@@ -775,7 +810,7 @@ proc tclPkgUnknown {name version {exact {}}} {
 	    set dir [lindex $auto_path $i]
 	    tclMacPkgSearch $dir
 	    foreach x [glob -nocomplain [file join $dir *]] {
-		if [file isdirectory $x] {
+		if {[file isdirectory $x]} {
 		    set dir $x
 		    tclMacPkgSearch $dir
 		}
diff --git a/library/parray.tcl b/library/parray.tcl
index 430e7ff..d80ad8d 100644
--- a/library/parray.tcl
+++ b/library/parray.tcl
@@ -1,7 +1,7 @@
 # parray:
 # Print the contents of a global array on stdout.
 #
-# SCCS: @(#) parray.tcl 1.9 96/02/16 08:56:44
+# SCCS: %Z% $Id: parray.tcl,v 1.2 1998/06/27 18:11:25 welch Exp $ 
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
@@ -12,7 +12,7 @@
 
 proc parray {a {pattern *}} {
     upvar 1 $a array
-    if ![array exists array] {
+    if {![array exists array]} {
 	error "\"$a\" isn't an array"
     }
     set maxl 0
diff --git a/library/safe.tcl b/library/safe.tcl
index 9b93523..9eb9a3f 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) safe.tcl 1.26 97/08/21 11:57:20
+# SCCS: %Z% $Id: safe.tcl,v 1.2 1998/06/27 18:11:25 welch Exp $ 
 
 #
 # The implementation is based on namespaces. These naming conventions
@@ -417,7 +417,7 @@ proc ::safe::interpAddToAccessPath {slave path} {
 
 	Lappend [VirtualPathListName $slave] $token;
 	Lappend [PathListName $slave] $path;
-	Set $nname [expr $n+1];
+	Set $nname [expr {$n+1}];
 
 	SyncAccessPath $slave;
 
@@ -528,7 +528,7 @@ proc ::safe::interpDelete {slave} {
 		# remove the hook now, otherwise if the hook
 		# calls us somehow, we'll loop
 		Unset $hookname;
-		if {[catch {eval $hook $slave} err]} {
+		if {[catch {eval $hook [list $slave]} err]} {
 		    Log $slave "Delete hook error ($err)";
 		}
 	    }
@@ -681,7 +681,7 @@ proc ::safe::setLogCmd {args} {
 	if {[regexp {(::)|(\.\.)} $path]} {
 	    error "invalid characters in path $path";
 	}
-	set n [expr [Set [PathNumberName $slave]]-1];
+	set n [expr {[Set [PathNumberName $slave]]-1}];
 	for {} {$n>=0} {incr n -1} {
 	    # fill the token virtual names with their real value
 	    set [PathToken $n] [Set [PathToken $n $slave]];
diff --git a/library/word.tcl b/library/word.tcl
index 64639f2..56fca90 100644
--- a/library/word.tcl
+++ b/library/word.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.
 # 
-# SCCS: @(#) word.tcl 1.2 96/11/20 14:07:22
+# SCCS: %Z% $Id: word.tcl,v 1.2 1998/06/27 18:11:26 welch Exp $ 
 # 
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -42,8 +42,8 @@ if {$tcl_platform(platform) == "windows"} {
 proc tcl_wordBreakAfter {str start} {
     global tcl_nonwordchars tcl_wordchars
     set str [string range $str $start end]
-    if [regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result] {
-	return [expr [lindex $result 1] + $start]
+    if {[regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result]} {
+	return [expr {[lindex $result 1] + $start}]
     }
     return -1
 }
@@ -64,7 +64,7 @@ proc tcl_wordBreakBefore {str start} {
     if {[string compare $start end] == 0} {
 	set start [string length $str]
     }
-    if [regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result] {
+    if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} {
 	return [lindex $result 1]
     }
     return -1
@@ -84,9 +84,9 @@ proc tcl_wordBreakBefore {str start} {
 
 proc tcl_endOfWord {str start} {
     global tcl_nonwordchars tcl_wordchars
-    if [regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \
-	    [string range $str $start end] result] {
-	return [expr [lindex $result 1] + $start]
+    if {[regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \
+	    [string range $str $start end] result]} {
+	return [expr {[lindex $result 1] + $start}]
     }
     return -1
 }
@@ -105,9 +105,9 @@ proc tcl_endOfWord {str start} {
 
 proc tcl_startOfNextWord {str start} {
     global tcl_nonwordchars tcl_wordchars
-    if [regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \
-	    [string range $str $start end] result] {
-	return [expr [lindex $result 1] + $start]
+    if {[regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \
+	    [string range $str $start end] result]} {
+	return [expr {[lindex $result 1] + $start}]
     }
     return -1
 }
@@ -126,9 +126,9 @@ proc tcl_startOfPreviousWord {str start} {
     if {[string compare $start end] == 0} {
 	set start [string length $str]
     }
-    if [regexp -indices \
+    if {[regexp -indices \
 	    "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \
-	    [string range $str 0 [expr $start - 1]] result word] {
+	    [string range $str 0 [expr {$start - 1}]] result word]} {
 	return [lindex $word 0]
     }
     return -1
diff --git a/mac/tclMacAlloc.c b/mac/tclMacAlloc.c
index 59d1417..6736675 100644
--- a/mac/tclMacAlloc.c
+++ b/mac/tclMacAlloc.c
@@ -23,6 +23,7 @@
 #include <stdlib.h>
 #include <string.h>
 
+
 /*
  * Flags that are used by ConfigureMemory to define how the allocator
  * should work.  They can be or'd together.
@@ -242,6 +243,7 @@ TclpSysFree(
 
     hand = * (Handle *) ((Ptr) ptr - sizeof(Handle));
     DisposeHandle(hand);
+    *hand = NULL;
     err = MemError();
 }
 
@@ -272,7 +274,9 @@ CleanUpExitProc()
     while (systemMemory != NULL) {
 	memRecord = systemMemory;
 	systemMemory = memRecord->next;
-	DisposeHandle(memRecord->memoryHandle);
+        if (*(memRecord->memoryHandle) != NULL) {
+            DisposeHandle(memRecord->memoryHandle);
+        }
 	DisposePtr((void *) memRecord);
     }
 }
@@ -303,13 +307,17 @@ FreeAllMemory()
     while (systemMemory != NULL) {
 	memRecord = systemMemory;
 	systemMemory = memRecord->next;
-	DisposeHandle(memRecord->memoryHandle);
+	if (*(memRecord->memoryHandle) != NULL) {
+            DisposeHandle(memRecord->memoryHandle);
+        }
 	DisposePtr((void *) memRecord);
     }
     while (appMemory != NULL) {
 	memRecord = appMemory;
 	appMemory = memRecord->next;
-	DisposeHandle(memRecord->memoryHandle);
+	if (*(memRecord->memoryHandle) != NULL) {
+            DisposeHandle(memRecord->memoryHandle);
+        }
 	DisposePtr((void *) memRecord);
     }
 }
diff --git a/tests/opt.test b/tests/opt.test
index 0b35b76..69d981c 100644
--- a/tests/opt.test
+++ b/tests/opt.test
@@ -253,3 +253,25 @@ test opt-10.10 {medium size overall test} {
     list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0]
 } {1 {too many arguments (unexpected argument(s): foo), usage:}}
 
+
+test opt-11.1 {too many args test 2} {
+    set key [::tcl::OptKeyRegister {-foo}]
+    list [catch {::tcl::OptKeyParse $key {-foo blah}} msg] $msg\
+	    [::tcl::OptKeyDelete $key]
+} {1 {too many arguments (unexpected argument(s): blah), usage:
+    Var/FlagName Type     Value   Help
+    ------------ ----     -----   ----
+    ( -help                       gives this help )
+    -foo         boolflag (false) } {}}
+
+
+
+test opt-11.2 {default value for args} {
+    set args {}
+    set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
+    ::tcl::OptKeyParse $key {}
+    ::tcl::OptKeyDelete $key
+    set args
+} {a b c}
+
+
diff --git a/tests/socket.test b/tests/socket.test
index 24f9e2a..e2697c2 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -981,6 +981,18 @@ test socket-9.3 {testing EOF stickyness} {
 	    }
 	}
     }
+test socket-10.1 {testing socket accept callback error handling} {
+    set goterror 0
+    proc bgerror args {global goterror; set goterror 1}
+    set s [socket -server accept 2898]
+    proc accept {s a p} {close $s; error}
+    set c [socket localhost 2898]
+    vwait goterror
+    close $s
+    close $c
+    set goterror
+} 1
+
     proc timerproc {} {
 	global done count c
 	set done true
@@ -1018,7 +1030,7 @@ if {$doTestsWithRemoteServer == 0} {
     return
 }
 
-test socket-10.1 {tcp connection} {
+test socket-11.1 {tcp connection} {
     sendCommand {
 	set socket9_1_test_server [socket -server accept 2834]
 	proc accept {s a p} {
@@ -1032,7 +1044,7 @@ test socket-10.1 {tcp connection} {
     sendCommand {close $socket9_1_test_server}
     set r
 } done
-test socket-10.2 {client specifies its port} {
+test socket-11.2 {client specifies its port} {
     if {[info exists port]} {
 	incr port
     } else {
@@ -1056,10 +1068,7 @@ test socket-10.2 {client specifies its port} {
     }
     set result
 } ok
-#
-# Tests io-10.3, io-10.4 have been removed.
-#
-test socket-10.3 {trying to connect, no server} {
+test socket-11.3 {trying to connect, no server} {
     set status ok
     if {![catch {set s [socket $remoteServerIp 2836]}]} {
 	if {![catch {gets $s}]} {
@@ -1069,7 +1078,7 @@ test socket-10.3 {trying to connect, no server} {
     }
     set status
 } ok
-test socket-10.4 {remote echo, one line} {
+test socket-11.4 {remote echo, one line} {
     sendCommand {
 	set socket10_6_test_server [socket -server accept 2836]
 	proc accept {s a p} {
@@ -1093,7 +1102,7 @@ test socket-10.4 {remote echo, one line} {
     sendCommand {close $socket10_6_test_server}
     set r
 } hello
-test socket-10.5 {remote echo, 50 lines} {
+test socket-11.5 {remote echo, 50 lines} {
     sendCommand {
 	set socket10_7_test_server [socket -server accept 2836]
 	proc accept {s a p} {
@@ -1127,7 +1136,7 @@ if {$tcl_platform(platform) == "macintosh"} {
 } else {
     set conflictResult {1 {couldn't open socket: address already in use}}
 }
-test socket-10.6 {socket conflict} {
+test socket-11.6 {socket conflict} {
     set s1 [socket -server accept 2836]
     if {[catch {set s2 [socket -server accept 2836]} msg]} {
 	set result [list 1 $msg]
@@ -1138,7 +1147,7 @@ test socket-10.6 {socket conflict} {
     close $s1
     set result
 } $conflictResult
-test socket-10.7 {server with several clients} {
+test socket-11.7 {server with several clients} {
     sendCommand {
 	set socket10_9_test_server [socket -server accept 2836]
 	proc accept {s a p} {
@@ -1174,7 +1183,7 @@ test socket-10.7 {server with several clients} {
     sendCommand {close $socket10_9_test_server}
     set i
 } 100    
-test socket-10.8 {client with several servers} {
+test socket-11.8 {client with several servers} {
     sendCommand {
 	set s1 [socket -server "accept 4003" 4003]
 	set s2 [socket -server "accept 4004" 4004]
@@ -1200,7 +1209,7 @@ test socket-10.8 {client with several servers} {
     }
     set l
 } {4003 {} 1 4004 {} 1 4005 {} 1}
-test socket-10.9 {accept callback error} {
+test socket-11.9 {accept callback error} {
     set s [socket -server accept 2836]
     proc accept {s a p} {expr 10 / 0}
     proc bgerror args {
@@ -1222,7 +1231,7 @@ test socket-10.9 {accept callback error} {
     rename bgerror {}
     set x
 } {{divide by zero}}
-test socket-10.10 {testing socket specific options} {
+test socket-11.10 {testing socket specific options} {
     sendCommand {
 	set socket10_12_test_server [socket -server accept 2836]
 	proc accept {s a p} {close $s}
@@ -1236,7 +1245,7 @@ test socket-10.10 {testing socket specific options} {
     sendCommand {close $socket10_12_test_server}
     set l
 } {2836 3 3}
-test socket-10.11 {testing spurious events} {
+test socket-11.11 {testing spurious events} {
     sendCommand {
 	set socket10_13_test_server [socket -server accept 2836]
 	proc accept {s a p} {
@@ -1275,7 +1284,7 @@ test socket-10.11 {testing spurious events} {
     sendCommand {close $socket10_13_test_server}
     list $spurious $len
 } {0 2690}
-test socket-10.12 {testing EOF stickyness} {
+test socket-11.12 {testing EOF stickyness} {
     set counter 0
     set done 0
     proc count_up {s} {
@@ -1308,7 +1317,7 @@ test socket-10.12 {testing EOF stickyness} {
     sendCommand {close $socket10_14_test_server}
     set done
 } {EOF is sticky}
-test socket-10.13 {testing async write, async flush, async close} {
+test socket-11.13 {testing async write, async flush, async close} {
     proc readit {s} {
 	global count done
 	set l [read $s]
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 56df95d..baff098 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -45,55 +45,11 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
 static int initialized = 0;
 
 /*
- * The following string is the startup script executed in new
- * interpreters.  It looks on disk in several different directories
- * for a script "init.tcl" that is compatible with this version
- * of Tcl.  The init.tcl script does all of the real work of
- * initialization.
+ * The Init script (common to Windows and Unix platforms) is
+ * defined in tclInitScript.h
  */
 
-static char initScript[] =
-"proc tclInit {} {\n\
-    global tcl_library tcl_version tcl_patchLevel env errorInfo\n\
-    global tcl_pkgPath\n\
-    rename tclInit {}\n\
-    set errors {}\n\
-    set dirs {}\n\
-    if {[info exists env(tcl_pkgLibrary)]} {\n\
-        lappend dirs $env(tcl_pkgLibrary)\n\
-    }\n\
-    if [info exists env(TCL_LIBRARY)] {\n\
-	lappend dirs $env(TCL_LIBRARY)\n\
-    }\n\
-    lappend dirs [info library]\n\
-    set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
-    lappend dirs $parentDir/lib/tcl$tcl_version\n\
-    if [string match {*[ab]*} $tcl_patchLevel] {\n\
-	set lib tcl$tcl_patchLevel\n\
-    } else {\n\
-	set lib tcl$tcl_version\n\
-    }\n\
-    lappend dirs [file dirname $parentDir]/$lib/library\n\
-    lappend dirs $parentDir/library\n\
-    foreach i $dirs {\n\
-	set tcl_library $i\n\
-	set tclfile [file join $i init.tcl]\n\
-	if {[file exists $tclfile]} {\n\
-            lappend tcl_pkgPath [file dirname $i]\n\
-	    if ![catch {uplevel #0 [list source $tclfile]} msg] {\n\
-		return\n\
-	    } else {\n\
-		append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
-	    }\n\
-	}\n\
-    }\n\
-    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
-    append msg \"    $dirs\n\n\"\n\
-    append msg \"$errors\n\n\"\n\
-    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
-    error $msg\n\
-}\n\
-tclInit";
+#include "tclInitScript.h"
 
 /*
  * Static routines in this file:
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index fee2aa7..6f7425c 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -66,82 +66,12 @@ static char* processors[NUMPROCESSORS] = {
 };
 
 /*
- * The following string is the startup script executed in new
- * interpreters.  It looks on disk in several different directories
- * for a script "init.tcl" that is compatible with this version
- * of Tcl.  The init.tcl script does all of the real work of
- * initialization.
+ * The Init script (common to Windows and Unix platforms) is
+ * defined in tclInitScript.h
  */
 
-static char *initScript =
-"proc init {} {\n\
-    global tcl_library tcl_platform tcl_version tcl_patchLevel env errorInfo\n\
-    global tcl_pkgPath\n\
-    rename init {}\n\
-    set errors {}\n\
-    proc tcl_envTraceProc {lo n1 n2 op} {\n\
-	global env\n\
-	set x $env($n2)\n\
-	set env($lo) $x\n\
-	set env([string toupper $lo]) $x\n\
-    }\n\
-    foreach p [array names env] {\n\
-	set u [string toupper $p]\n\
-	if {$u != $p} {\n\
-	    switch -- $u {\n\
-		COMSPEC -\n\
-		PATH {\n\
-		    if {![info exists env($u)]} {\n\
-			set env($u) $env($p)\n\
-		    }\n\
-		    trace variable env($p) w [list tcl_envTraceProc $p]\n\
-		    trace variable env($u) w [list tcl_envTraceProc $p]\n\
-		}\n\
-	    }\n\
-	}\n\
-    }\n\
-    if {![info exists env(COMSPEC)]} {\n\
-	if {$tcl_platform(os) == {Windows NT}} {\n\
-	    set env(COMSPEC) cmd.exe\n\
-	} else {\n\
-	    set env(COMSPEC) command.com\n\
-	}\n\
-    }	\n\
-    set dirs {}\n\
-    if {[info exists env(tcl_pkgLibrary)]} {\n\
-	lappend dirs $env(tcl_pkgLibrary)\n\
-    }\n\
-    if {[info exists env(TCL_LIBRARY)]} {\n\
-	lappend dirs $env(TCL_LIBRARY)\n\
-    }\n\
-    lappend dirs $tcl_library\n\
-    lappend dirs [file join [file dirname [file dirname [info nameofexecutable]]] lib/tcl$tcl_version]\n\
-    if [string match {*[ab]*} $tcl_patchLevel] {\n\
-	set lib tcl$tcl_patchLevel\n\
-    } else {\n\
-	set lib tcl$tcl_version\n\
-    }\n\
-    lappend dirs [file join [file dirname [file dirname [pwd]]] $lib/library]\n\
-    lappend dirs [file join [file dirname [pwd]] library]\n\
-    foreach i $dirs {\n\
-	set tcl_library $i\n\
-	set tclfile [file join $i init.tcl]\n\
-	if {[file exists $tclfile]} {\n\
-            lappend tcl_pkgPath [file dirname $i]\n\
-	    if ![catch {uplevel #0 [list source $tclfile]} msg] {\n\
-	        return\n\
-	    } else {\n\
-		append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
-	    }\n\
-	}\n\
-    }\n\
-    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
-    append msg \"    $dirs\n\n\"\n\
-    append msg \"$errors\n\n\"\n\
-    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
-    error $msg\n\
-}\n\
-init\n";
+#include "tclInitScript.h"
+
 
 /*
  *----------------------------------------------------------------------