Backport of fix for Bug #545644

3 files changed, 27 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index 1d9cfae..fec922c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2002-04-19  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]
+
 2002-04-18  Miguel Sofer  <msofer@users.sourceforge.net>
 
 	* generic/tclNamesp.c:
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 2f8362d..5b30f39 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -14,7 +14,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.24.2.3 2001/10/08 15:50:24 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.24.2.4 2002/04/19 08:12:39 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -579,6 +579,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 aee33b2..15046e0 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.15.2.1 2002/04/18 18:15:27 msofer Exp $
+# RCS: @(#) $Id: info.test,v 1.15.2.2 2002/04/19 08:12:39 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"