summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclCmdIL.c9
-rw-r--r--tests/info.test18
3 files changed, 25 insertions, 6 deletions
diff --git a/ChangeLog b/ChangeLog
index b8d8616..74d50c0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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"