diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 9 | ||||
| -rw-r--r-- | tests/info.test | 18 |
3 files changed, 25 insertions, 6 deletions
@@ -1,5 +1,9 @@ 2002-04-18 Donal K. Fellows <fellowsd@cs.man.ac.uk> + * generic/tclCmdIL.c (InfoBodyCmd): + * tests/info.test (info-2.6): Proc bodies without string reps + would report as empty [Bug #545644] + * generic/tclCmdMZ.c (Tcl_SubstObj): More clarification for comment on behaviour when substitutions are not well-formed, prompted by [Bug #536831]; alas, removing the ill-defined diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 405245a..3e1f0da 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -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: tclCmdIL.c,v 1.42 2002/03/06 11:28:08 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.43 2002/04/18 14:12:07 dkf Exp $ */ #include "tclInt.h" @@ -611,6 +611,13 @@ InfoBodyCmd(dummy, interp, objc, objv) */ bodyPtr = procPtr->bodyPtr; + if (bodyPtr->bytes == NULL) { + /* + * The string rep might not be valid if the procedure has + * never been run before. [Bug #545644] + */ + (void) Tcl_GetString(bodyPtr); + } resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length); Tcl_SetObjResult(interp, resultPtr); diff --git a/tests/info.test b/tests/info.test index 9ed73b2..0e209fc 100644 --- a/tests/info.test +++ b/tests/info.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: info.test,v 1.18 2002/02/15 14:28:50 dkf Exp $ +# RCS: @(#) $Id: info.test,v 1.19 2002/04/18 14:12:07 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -79,11 +79,11 @@ test info-2.4 {info body option} { list [info body p] [info body q] } } {{return "x=$x"} {return "y=$y"}} +# Prior to 8.3.0 this would cause a crash because [info body] +# would return the bytecompiled version of foo, which the catch +# would then try and eval out of the foo context, accessing +# compiled local indices test info-2.5 {info body option, returning bytecompiled bodies} { - # Prior to 8.3.0 this would cause a crash because [info body] - # would return the bytecompiled version of foo, which the catch - # would then try and eval out of the foo context, accessing - # compiled local indices catch {unset args} proc foo {args} { foreach v $args { @@ -94,6 +94,14 @@ test info-2.5 {info body option, returning bytecompiled bodies} { foo a list [catch [info body foo] msg] $msg } {1 {can't read "args": no such variable}} +# Fix for problem tested for in info-2.5 caused problems when +# procedure body had no string rep (i.e. was not yet bytecode) +# causing an empty string to be returned [Bug #545644] +test info-2.6 {info body option, returning list bodies} { + proc foo args [list subst bar] + list [string bytelength [info body foo]] \ + [foo; string bytelength [info body foo]] +} {9 9} # "info cmdcount" is no longer accurate for compiled commands! # The expected result for info-3.1 used to be "3" and is now "1" |