Tcl Source Code

I am seeing a crash in Tcl_ListObjReplace, caused by a combination of invalid arguments and a NULL interp.

This is the stacktrace:

ore file '/home/gahr/tcl/unix/../../tclsh.core' (aarch64) was loaded.                                                                                            
(lldb) bt                                                                                                                                                         
* thread #1: tid = 101137, 0x0000000040547678 libtcl8.7.so`Tcl_SetObjResult + 12, name = 'tclsh', stop reason = signal SIGSEGV                                    
  * frame #0: 0x0000000040547678 libtcl8.7.so`Tcl_SetObjResult + 12                                                                                               
    frame #1: 0x000000004052ce1c libtcl8.7.so`Tcl_ListObjReplace + 252                                                                                            
    frame #2: 0x00000000404f8520 libtcl8.7.so`TclCompileEnsemble + 1312                                                                                           
    frame #3: 0x00000000404f93c0 libtcl8.7.so`TclAttemptCompileProc + 212                                                                                         
    frame #4: 0x00000000404e20ec libtcl8.7.so`TclCompileScript + 1588                                                                                             
    frame #5: 0x00000000404e155c libtcl8.7.so`TclSetByteCodeFromAny + 164                                                                                         
    frame #6: 0x00000000404fcb30 libtcl8.7.so`TclCompileObj + 500                                                                                                 
    frame #7: 0x000000004047e7f4 libtcl8.7.so`TclNREvalObjEx + 476                                                                                                
    frame #8: 0x0000000040529e84 libtcl8.7.so`TclNREvalFile + 896                                                                                                 
    frame #9: 0x0000000040492a14 libtcl8.7.so`TclNRSourceObjCmd + 188                                                                                             
    frame #10: 0x000000004047c75c libtcl8.7.so`Tcl_EvalObjv + 104                                                                                                 
    frame #11: 0x000000004047db90 libtcl8.7.so`TclEvalEx + 2032                                                                                                   
    frame #12: 0x00000000004009b4 tclsh`Tcl_AppInit + 20                                                                                                          
    frame #13: 0x0000000040530540 libtcl8.7.so`Tcl_MainEx + 440                                                                                                   
    frame #14: 0x0000000000400990 tclsh`main + 48                                                                                                                 
    frame #15: 0x00000000004008c0 tclsh`__start + 360                                                                                                             
    frame #16: 0x0000000040412658 ld-elf.so.1 at rtld_start.S:41


The fix is in two parts.

1) Make sure Tcl_SetObjResult is not called if interp is NULL

Index: generic/tclListObj.c
==================================================================
--- generic/tclListObj.c
+++ generic/tclListObj.c
@@ -905,12 +905,14 @@

        count = numElems - first;
     }

     if (objc > LIST_MAX - (numElems - count)) {
-       Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-               "max length of a Tcl list (%d elements) exceeded", LIST_MAX));
+       if (interp != NULL) {
+           Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                   "max length of a Tcl list (%d elements) exceeded", LIST_MAX));
+       }
        return TCL_ERROR;
     }
     isShared = (listRepPtr->refCount > 1);
     numRequired = numElems - count + objc; /* Known <= LIST_MAX */
     needGrow = numRequired > listRepPtr->maxElemCount;


2) Avoid calling Tcl_ListObjReplace with an invalid combination of arguments

Index: generic/tclEnsemble.c
==================================================================
--- generic/tclEnsemble.c
+++ generic/tclEnsemble.c
@@ -3133,11 +3133,11 @@
        /*
         * The length of the "replaced" list must be depth-1.  Trim back
         * any extra elements that might have been appended by failing
         * pathways above.
         */
-       (void) Tcl_ListObjReplace(NULL, replaced, depth-1, INT_MAX, 0, NULL);
+       (void) Tcl_ListObjReplace(NULL, replaced, depth-1, LIST_MAX, 0, NULL);

        /*
         * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
         * when depth==1.  In that case we are choosing to emit the
         * INST_INVOKE_REPLACE bytecode when there is in fact no replacing


I am happy to commit this myself, but I would rather seek opinion on part 2) first.

I should mention that this is happening only on FreeBSD 12-CURRENT, arm64 (ARMv8).