From eb1d187f6b45b49683df1093661e3dd3b00844f3 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Fri, 11 Feb 2005 12:15:28 +0000 Subject: * tests/basic.test (basic-26.3): new test --- ChangeLog | 4 ++++ tests/basic.test | 23 +++++++++++++++++++++-- 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 + + * tests/basic.test (basic-26.3): new test + 2005-02-10 Miguel Sofer * 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} { } {} -- cgit v0.12