merge trunk

10 files changed, 63 insertions, 26 deletions

diff --git a/ChangeLog b/ChangeLog
index 378b0ae..4ac5205 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2012-06-11  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclBasic.c:	[Bug 3532959] Make sure the lifetime management
+	* generic/tclProc.c:	of entries in the linePBodyPtr hash table can
+	* tests/proc.test:	tolerate either order of teardown, interp first,
+	or Proc first.
+
 2012-06-08  Don Porter  <dgp@users.sourceforge.net>
 
 	* unix/configure.in:	Update autogoo for gettimeofday().
diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll
index 869b00d..9943b3e 100644
--- a/compat/zlib/win32/zlib1.dll
+++ b/compat/zlib/win32/zlib1.dll
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b38558a..0b02d0d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1555,12 +1555,16 @@ DeleteInterpProc(
 	    hPtr != NULL;
 	    hPtr = Tcl_NextHashEntry(&search)) {
 	CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
+	Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
 
-	if (cfPtr->type == TCL_LOCATION_SOURCE) {
-	    Tcl_DecrRefCount(cfPtr->data.eval.path);
+	procPtr->iPtr = NULL;
+	if (cfPtr) {
+	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
+		Tcl_DecrRefCount(cfPtr->data.eval.path);
+	    }
+	    ckfree(cfPtr->line);
+	    ckfree(cfPtr);
 	}
-	ckfree(cfPtr->line);
-	ckfree(cfPtr);
 	Tcl_DeleteHashEntry(hPtr);
     }
     Tcl_DeleteHashTable(iPtr->linePBodyPtr);
diff --git a/generic/tclProc.c b/generic/tclProc.c
index d008217..7b0af3a 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2234,7 +2234,7 @@ TclProcCleanupProc(
      * procbody structures created by tbcload.
      */
 
-    if (!iPtr) {
+    if (iPtr == NULL) {
 	return;
     }
 
@@ -2245,13 +2245,15 @@ TclProcCleanupProc(
 
     cfPtr = Tcl_GetHashValue(hePtr);
 
-    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-	Tcl_DecrRefCount(cfPtr->data.eval.path);
-	cfPtr->data.eval.path = NULL;
+    if (cfPtr) {
+	if (cfPtr->type == TCL_LOCATION_SOURCE) {
+	    Tcl_DecrRefCount(cfPtr->data.eval.path);
+	    cfPtr->data.eval.path = NULL;
+	}
+	ckfree(cfPtr->line);
+	cfPtr->line = NULL;
+	ckfree(cfPtr);
     }
-    ckfree(cfPtr->line);
-    cfPtr->line = NULL;
-    ckfree(cfPtr);
     Tcl_DeleteHashEntry(hePtr);
 }
 
@@ -2483,7 +2485,8 @@ SetLambdaFromAny(
     Interp *iPtr = (Interp *) interp;
     const char *name;
     Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
-    int objc, result;
+    int isNew, objc, result;
+    CmdFrame *cfPtr = NULL;
     Proc *procPtr;
 
     if (interp == NULL) {
@@ -2578,14 +2581,14 @@ SetLambdaFromAny(
 
 	    if (contextPtr->line
 		    && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
-		int isNew, buf[2];
-		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
+		int buf[2];
 
 		/*
 		 * Move from approximation (line of list cmd word) to actual
 		 * location (line of 2nd list element).
 		 */
 
+		cfPtr = ckalloc(sizeof(CmdFrame));
 		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
 
 		cfPtr->level = -1;
@@ -2601,9 +2604,6 @@ SetLambdaFromAny(
 
 		cfPtr->cmd.str.cmd = NULL;
 		cfPtr->cmd.str.len = 0;
-
-		Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			procPtr, &isNew), cfPtr);
 	    }
 
 	    /*
@@ -2615,6 +2615,8 @@ SetLambdaFromAny(
 	}
 	TclStackFree(interp, contextPtr);
     }
+    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr,
+	    &isNew), cfPtr);
 
     /*
      * Set the namespace for this lambda: given by objv[2] understood as a
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index 5b4eae9..fef4f24 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,5 +1,5 @@
 if {![package vsatisfies [package provide Tcl] 8.5]} return
-if {[string compare [info sharedlibextension] .dll]} return
+if {[info sharedlibextension] ne ".dll"} return
 if {[::tcl::pkgconfig get debug]} {
     package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
 } else {
diff --git a/library/platform/shell.tcl b/library/platform/shell.tcl
index e0a129a..d37cdcd 100644
--- a/library/platform/shell.tcl
+++ b/library/platform/shell.tcl
@@ -187,7 +187,7 @@ proc ::platform::shell::TEMP {} {
  	    }
  	}
     }
-    if {[string compare $channel ""]} {
+    if {$channel != ""} {
  	return -code error "Failed to open a temporary file: $channel"
     } else {
  	return -code error "Failed to find an unused temporary file name"
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index 067425f..f87d15c 100755
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,5 +1,5 @@
 if {![package vsatisfies [package provide Tcl] 8.5]} return
-if {[string compare [info sharedlibextension] .dll]} return
+if {[info sharedlibextension] ne ".dll"} return
 if {[::tcl::pkgconfig get debug]} {
     package ifneeded registry 1.3 \
             [list load [file join $dir tclreg13g.dll] registry]
diff --git a/tests/fCmd.test b/tests/fCmd.test
index f2adcef..72b7da9 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -39,6 +39,7 @@ if {[testConstraint win]} {
     }
 }
 
+set tmpspace /tmp;# default value
 # Find a group that exists on this Unix system, or else skip tests that
 # require Unix groups.
 testConstraint foundGroup [expr {![testConstraint unix]}]
@@ -591,7 +592,7 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
     [subst {error renaming "td2" to "[file join td1 td2]": file *}]
 test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
     cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
     createfile tf1
     file rename tf1 $tmpspace
     glob -nocomplain tf* [file join $tmpspace tf1]
@@ -610,21 +611,21 @@ test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
 } -result {d:/tcl8975@}
 test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
     cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
     file mkdir td1
     file rename td1 $tmpspace
     glob -nocomplain td* [file join $tmpspace td*]
 } -result [file join $tmpspace td1]
 test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
     cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
     createfile tf1
     file rename tf1 $tmpspace
     glob -nocomplain tf* [file join $tmpspace tf*]
 } -result [file join $tmpspace tf1]
 test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
     cleanup $tmpspace
-} -constraints {notRoot xdev} -body {
+} -constraints {xdev notRoot} -body {
     file mkdir td1/td2/td3
     file attributes td1 -permissions 0000
     file rename td1 $tmpspace
@@ -693,7 +694,7 @@ test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
 } -result [file join $tmpspace td1 td2]
 test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
     cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
     file mkdir foo/bar
     file attr foo -perm 040555
     file rename foo/bar $tmpspace
@@ -1353,7 +1354,7 @@ test fCmd-12.8 {renamefile: generic error} -setup {
 } -result {1}
 test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
     cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {unix notRoot} -body {
     set s [createfile tfa]
     file rename tfa $tmpspace
     list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
diff --git a/tests/proc.test b/tests/proc.test
index ed3c4b6..e06720e 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -374,6 +374,15 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body {
 } -cleanup {
     namespace delete ugly
 } -result 4
+
+test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
+    set lambda x
+    lappend lambda {set a 1}
+    interp create slave
+    slave eval [list apply $lambda foo]
+    interp delete slave
+    unset lambda
+} {}
 
 # cleanup
 catch {rename p ""}
diff --git a/tests/safe.test b/tests/safe.test
index dcd5bfd..4a2792e 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -334,6 +334,20 @@ test safe-8.9 {safe source and return} -setup {
     catch {safe::interpDelete $i}
     removeFile $returnScript
 } -result ok
+test safe-8.10 {safe source and return} -setup {
+    set returnScript [makeFile {return -level 2 "ok"} return.tcl]
+    catch {safe::interpDelete $i}
+} -body {
+    safe::interpCreate $i
+    set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
+    $i eval [list apply {filename {
+	source $filename
+	error boom
+    }} $token/[file tail $returnScript]]
+} -cleanup {
+    catch {safe::interpDelete $i}
+    removeFile $returnScript
+} -result ok
 
 test safe-9.1 {safe interps' deleteHook} -setup {
     set i "a"