* tests/basic.test (basic-26.3): new test

2 files changed, 25 insertions, 2 deletions

diff --git a/ChangeLog b/ChangeLog
index 55443b0..f4037f8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2005-02-11  Miguel Sofer <msofer@users.sf.net>
+
+	* tests/basic.test (basic-26.3): new test
+
 2005-02-10  Miguel Sofer <msofer@users.sf.net>
 
 	* generic/tclBasic.c (Tcl_EvalObjEx):
diff --git a/tests/basic.test b/tests/basic.test
index 7a4b58d..aaf6a65 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -15,7 +15,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: basic.test,v 1.37 2005/02/10 19:08:12 msofer Exp $
+# RCS: @(#) $Id: basic.test,v 1.38 2005/02/11 12:15:45 msofer Exp $
 #
 
 package require tcltest 2
@@ -444,7 +444,8 @@ test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
     #   a - the pure-list internal rep is destroyed by shimmering
     #   b - the command returns an error
     # As the error code in Tcl_EvalObjv accesses the list elements, this will
-    # cause a segfault if [Bug 1119369] has not been fixed.
+    # cause a segfault if [Bug 1119369] has not been fixed. 
+    # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
     #
 
     set SRC [list foo 1] ;# pure-list command 
@@ -456,6 +457,24 @@ test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
     catch {eval $SRC}
 } 1
 
+test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
+    #
+    # Follow the pure-list branch in a manner that
+    #   a - the pure-list internal rep is destroyed by shimmering
+    #   b - the command accesses its command line
+    # This will cause a segfault if [Bug 1119369] has not been fixed. 
+    # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
+    #
+
+    set SRC [list foo 1] ;# pure-list command 
+    proc foo str {
+	# Shimmer pure-list to cmdName, cleanup and error
+	proc $::SRC {} {}; $::SRC
+	info level 0
+    }
+    catch {eval $SRC}
+} 0
+
 test basic-27.1 {Tcl_ExprLong} {emptyTest} {
 } {}