diff options
| -rw-r--r-- | generic/tclTestObj.c | 22 | ||||
| -rw-r--r-- | tests/listObj.test | 33 |
2 files changed, 55 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; } diff --git a/tests/listObj.test b/tests/listObj.test index 0f43648..55fc089 100644 --- a/tests/listObj.test +++ b/tests/listObj.test @@ -278,6 +278,39 @@ test listobj-13.3 {Tcl_ListObjElements memory leaks for lseq} -constraints { }] $errorMessage } -result {0 {}} +# Tests for Tcl_ListObjIndex as sematics are different from lindex for +# out of bounds indices. Out of bounds should return a null pointer and +# not empty string. +test listobj-14.1 {Tcl_ListObjIndex out-of-bounds index for native lists} -constraints { + testobj +} -setup { + testobj set 1 [list a b c] +} -cleanup { + testobj freeallvars +} -body { + list [testlistobj index 1 -1] [testlistobj index 1 3] +} -result {null null} + +test listobj-14.2 {Tcl_ListObjIndex out-of-bounds index for native lists with spans} -constraints { + testobj +} -setup { + testobj set 1 [testlistrep new 1000 100 100] +} -cleanup { + testobj freeallvars +} -body { + list [testlistobj index 1 -1] [testlistobj index 1 1000] +} -result {null null} + +test listobj-14.3 {Tcl_ListObjIndex out-of-bounds index for lseq} -constraints { + testobj +} -setup { + testobj set 1 [lseq 3] +} -cleanup { + testobj freeallvars +} -body { + list [testlistobj index 1 -1] [testlistobj index 1 3] +} -result {null null} + # cleanup ::tcltest::cleanupTests return |