From de76c226887e818f393568bf07dd6fdebd8347de Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 18 Jun 2004 15:06:43 +0000
Subject: Added tests for deep-object-freeing

---
 tests/obj.test    | 10 +++++++++-
 tests/thread.test | 19 ++++++++++++++++++-
 2 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/tests/obj.test b/tests/obj.test
index a6bb192..da7ee7d 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: obj.test,v 1.8 2004/05/19 20:15:32 dkf Exp $
+# RCS: @(#) $Id: obj.test,v 1.9 2004/06/18 15:06:43 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -588,6 +588,14 @@ test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj nonPortable}
     testobj invalidateStringRep 1
 } end--2147483648
 
+test obj-32.1 {freeing very large object trees} {
+    set x {}
+    for {set i 0} {$i<100000} {incr i} {
+	set x [list $x {}]
+    }
+    unset x
+} {}
+
 if {[testConstraint testobj]} {
     testobj freeallvars
 }
diff --git a/tests/thread.test b/tests/thread.test
index 02bfc71..8e7c471 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -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.
 #
-# RCS: @(#) $Id: thread.test,v 1.12 2004/06/18 14:44:28 dkf Exp $
+# RCS: @(#) $Id: thread.test,v 1.13 2004/06/18 15:06:43 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -235,6 +235,23 @@ test thread-5.2 {Try to join a detached thread} {testthread} {
     lrange $msg 0 2
 } {cannot join thread}
 
+test thread-6.1 {freeing very large object trees in a thread} testthread {
+    # conceptual duplicate of obj-32.1
+    threadReap
+    set serverthread [testthread create -joinable]
+    testthread send -async $serverthread {
+	set x {}
+	for {set i 0} {$i<100000} {incr i} {
+	    set x [list $x {}]
+	}
+	unset x
+	testthread exit
+    }
+    catch {set res [testthread join $serverthread]} msg
+    threadReap
+    set res
+} {0}
+
 # cleanup
 ::tcltest::cleanupTests
 return
-- 
cgit v0.12