diff options
author | hobbs <hobbs> | 2007-11-12 02:07:18 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2007-11-12 02:07:18 (GMT) |
commit | cf8a7199f105edc95e59373e098af6eb47d22a16 (patch) | |
tree | c7f005156cbe08f8e11d6845d4a71f991dc5b488 /generic/tclExecute.c | |
parent | 094b6f7ae513ec561543276d7659f3a8b2a5b853 (diff) | |
download | tcl-cf8a7199f105edc95e59373e098af6eb47d22a16.zip tcl-cf8a7199f105edc95e59373e098af6eb47d22a16.tar.gz tcl-cf8a7199f105edc95e59373e098af6eb47d22a16.tar.bz2 |
* generic/tclCompCmds.c, generic/tclCompile.c, generic/tclCompile.h:
* generic/tclExecute.c, generic/tclInt.decls, generic/tclIntDecls.h:
* generic/tclRegexp.c, generic/tclRegexp.h: Add INST_REGEXP and fully
* generic/tclStubInit.c, generic/tclUtil.c: compiled [regexp] for the
* tests/regexpComp.test: [Bug 1830166] simple cases. Also
added TclReToGlob function to convert RE to glob patterns and use
these in the possible cases.
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r-- | generic/tclExecute.c | 35 |
1 files changed, 34 insertions, 1 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index cb72097..80247a6 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.345 2007/11/11 19:32:14 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.346 2007/11/12 02:07:19 hobbs Exp $ */ #include "tclInt.h" @@ -4098,6 +4098,39 @@ TclExecuteByteCode( NEXT_INST_F(2, 2, 1); } + case INST_REGEXP: { + int nocase, match; + Tcl_Obj *valuePtr, *value2Ptr; + Tcl_RegExp regExpr; + + nocase = TclGetInt1AtPtr(pc+1); + valuePtr = OBJ_AT_TOS; /* String */ + value2Ptr = OBJ_UNDER_TOS; /* Pattern */ + + regExpr = Tcl_GetRegExpFromObj(interp, value2Ptr, + TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0)); + if (regExpr == NULL) { + match = -1; + } else { + match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0); + } + + /* + * Adjustment is 2 due to the nocase byte + */ + + if (match < 0) { + objResultPtr = Tcl_GetObjResult(interp); + TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)), objResultPtr); + result = TCL_ERROR; + goto checkForCatch; + } else { + TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match)); + objResultPtr = constants[match]; + NEXT_INST_F(2, 2, 1); + } + } + case INST_EQ: case INST_NEQ: case INST_LT: |