Tcl Source Code

Artifact [d6565bdfec]
Login

Artifact d6565bdfec1923bd3f4602ba87d1f3ccc67d5e5a:

Attachment "tcl_bug.txt" to ticket [986651ffff] added by roylane 2004-07-07 22:23:10.
The following will cause Tcl to go into an infinite loop.  Note the missing
quote in the "error" command within the "while" block:

##################################################################

proc test_expr {} {

    return 1
}

proc test1 {} {

    set code [catch {

        while {[test_expr]} {

            error "missing ending quote
        }

    } msg]

    if {$code} {puts "$msg\n$::errorInfo"}

}

test1

####################################################################

Here's the byte code that shows what the problem is.  It's the "jump1 0"
at (5) that's causing the infinite loop.

Compiling body of proc "test1"

ByteCode 0x8236350, refCt 1, epoch 0, interp 0x8189308 (epoch 0)
  Source "\n\n    set code [catch {\n\n        while {[test_expr]} {\n"
  Cmds 4, src 163, inst 41, litObjs 7, aux 0, stkDepth 5, code/src 1.55
  Code 252 = header 100+inst 41+litObj 28+exc 56+aux 0+cmdMap 16
  Proc 0x8200cb0, refCt 1, args 0, compiled locals 2
      slot 0, scalar, "code"
      slot 1, scalar, "msg"
  Exception ranges 2, depth 2:
      0: level 1, catch, pc 5-3, catch -1
      1: level 2, loop, pc -1--3, continue -1, break -1
  Commands 4:
      1: pc 0-17, src 6-116   	   2: pc 0-14, src 16-115
      3: pc 18-39, src 123-160   	   4: pc 23-35, src 135-159
  Command 1: "set code [catch {\n\n        while {[test_expr]} {\n\n     "
  Command 2: "catch {\n\n        while {[test_expr]} {\n\n            err"
    (0) beginCatch4 0 
===>(5) jump1 0  	# pc 5
    (7) push1 0  	# "catch"
    (9) push1 1  	# "\n\n        while {[test_expr]} {\n\n       "
    (11) push1 2  	# "msg"
    (13) invokeStk1 3 
    (15) storeScalar1 0	# var "code"
    (17) pop 
  Command 3: "if {$code} {puts \"$msg\n$::errorInfo\"}"
    (18) loadScalar1 0	# var "code"
    (20) tryCvtToNumeric 
    (21) jumpFalse1 17  	# pc 38
  Command 4: "puts \"$msg\n$::errorInfo\""
    (23) push1 3  	# "puts"
    (25) loadScalar1 1	# var "msg"
    (27) push1 4  	# "\n"
    (29) push1 5  	# "::errorInfo"
    (31) loadScalarStk 
    (32) concat1 3 
    (34) invokeStk1 2 
    (36) jump1 4  	# pc 40
    (38) push1 6  	# ""
    (40) done 


If I understand what's going on correctly, the "jump1 0" was generated for
the expression of the while loop as a "placeholder" until the body is
compiled.  As the body is compiled, the problem with the missing quote is
encountered and the compiler code starts unwinding with an error status.  The
unwinding reaches "TclCompileScript()" at this point:

	    if (code == TCL_OK) {
		goto finishCommand;
	    } else if (code == TCL_OUT_LINE_COMPILE) {
		/*
=====>	 * Restore numCommands to its correct value, removing
		 * any commands compiled before TCL_OUT_LINE_COMPILE
		 * [Bug 705406]
		 */
		envPtr->numCommands = savedNumCmds;
	    } else { /* an error */

The error code was switched to TCL_OUT_LINE_COMPILE, so "numCommands" does get
reset in "envPtr", but the compiled byte code (particularly the "jump1 0")
doesn't get removed.  This is what causes the infinite loop.