diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2017-02-18 16:24:09 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2017-02-18 16:24:09 (GMT) |
| commit | fcf8e64d6b12e1682af90b9e25b364e22d04c7bf (patch) | |
| tree | b3f02f30b55376e1da06a9470a8624fb2c88f9ed | |
| parent | 768fa857c25a31f96cfdfeeb34e8628f68ddb7ba (diff) | |
| download | tcl-fcf8e64d6b12e1682af90b9e25b364e22d04c7bf.zip tcl-fcf8e64d6b12e1682af90b9e25b364e22d04c7bf.tar.gz tcl-fcf8e64d6b12e1682af90b9e25b364e22d04c7bf.tar.bz2 | |
Testing for some error cases.
| -rw-r--r-- | generic/tclCmdMZ.c | 8 | ||||
| -rw-r--r-- | tests/regexp.test | 6 |
2 files changed, 14 insertions, 0 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 110de4c..d5a6b01 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -677,6 +677,14 @@ Tcl_RegsubObjCmd( if (Tcl_ListObjLength(interp, objv[2], &numParts) != TCL_OK) { return TCL_ERROR; } + if (numParts < 1) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "command prefix must be a list of at least one element", + -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGSUB", + "CMDEMPTY", NULL); + return TCL_ERROR; + } regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); } diff --git a/tests/regexp.test b/tests/regexp.test index f1be6eb..2686526 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -1178,6 +1178,12 @@ test regexp-27.9 {regsub -command memory leak testing} memory { regsub -command -all {\d+} $::s $::t } } 0 +test regexp-27.10 {regsub -command error cases} -returnCodes error -body { + regsub -command . abc "def \{ghi" +} -result {unmatched open brace in list} +test regexp-27.11 {regsub -command error cases} -returnCodes error -body { + regsub -command . abc {} +} -result {command prefix must be a list of at least one element} # cleanup ::tcltest::cleanupTests |