Add tests for out of bounds Tcl_ListObjIndex

1 files changed, 22 insertions, 0 deletions

diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 3b21eaf..0080938 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -893,6 +893,7 @@ TestlistobjCmd(
 	"replace",
 	"indexmemcheck",
 	"getelementsmemcheck",
+	"index",
 	NULL
     };
     enum listobjCmdIndex {
@@ -901,6 +902,7 @@ TestlistobjCmd(
 	LISTOBJ_REPLACE,
 	LISTOBJ_INDEXMEMCHECK,
 	LISTOBJ_GETELEMENTSMEMCHECK,
+	LISTOBJ_INDEX,
     } cmdIndex;
 
     Tcl_Size varIndex;		/* Variable number converted to binary */
@@ -1008,6 +1010,26 @@ TestlistobjCmd(
 	    }
 	}
 	break;
+    case LISTOBJ_INDEX:
+	/*
+	 * Tcl_ListObjIndex semantics differ from lindex for out of bounds.
+	 * Hence this explicit test.
+	 */
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+			     "varIndex listIndex");
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) {
+	    return TCL_ERROR;
+	} else {
+	    Tcl_Obj *objP;
+	    if (Tcl_ListObjIndex(interp, varPtr[varIndex], first, &objP) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    Tcl_SetObjResult(interp, objP ? objP : Tcl_NewStringObj("null", -1));
+	}
+	break;
     }
     return TCL_OK;
 }