diff options
| -rw-r--r-- | generic/tclCmdIL.c | 8 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 58 | ||||
| -rw-r--r-- | tests/regexp.test | 51 |
3 files changed, 81 insertions, 36 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 6db0c53..b121c67 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.12 1999/04/16 00:46:43 stanton Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.13 1999/06/17 19:31:50 stanton Exp $ */ #include "tclInt.h" @@ -2372,9 +2372,9 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) index = -1; for (i = 0; i < listc; i++) { match = 0; - bytes = Tcl_GetStringFromObj(listv[i], &elemLen); switch ((enum options) mode) { case LSEARCH_EXACT: { + bytes = Tcl_GetStringFromObj(listv[i], &elemLen); if (length == elemLen) { match = (memcmp(bytes, patternBytes, (size_t) length) == 0); @@ -2382,11 +2382,11 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) break; } case LSEARCH_GLOB: { - match = Tcl_StringMatch(bytes, patternBytes); + match = Tcl_StringMatch(Tcl_GetString(listv[i]), patternBytes); break; } case LSEARCH_REGEXP: { - match = TclRegExpMatchObj(interp, bytes, patObj); + match = Tcl_RegExpMatchObj(interp, listv[i], patObj); if (match < 0) { return TCL_ERROR; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 3746cfc..36c75b2 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.15 1999/06/15 01:16:22 hershey Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.16 1999/06/17 19:31:50 stanton Exp $ */ #include "tclInt.h" @@ -144,7 +144,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) indices = 0; about = 0; - cflags = REG_ADVANCED; + cflags = TCL_REG_ADVANCED; eflags = 0; for (i = 1; i < objc; i++) { @@ -165,7 +165,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) break; } case REGEXP_NOCASE: { - cflags |= REG_ICASE; + cflags |= TCL_REG_NOCASE; break; } case REGEXP_ABOUT: { @@ -173,19 +173,19 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) break; } case REGEXP_EXPANDED: { - cflags |= REG_EXPANDED; + cflags |= TCL_REG_EXPANDED; break; } case REGEXP_LINE: { - cflags |= REG_NEWLINE; + cflags |= TCL_REG_NEWLINE; break; } case REGEXP_LINESTOP: { - cflags |= REG_NLSTOP; + cflags |= TCL_REG_NLSTOP; break; } case REGEXP_LINEANCHOR: { - cflags |= REG_NLANCH; + cflags |= TCL_REG_NLANCH; break; } case REGEXP_LAST: { @@ -217,7 +217,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) return TCL_OK; } - match = Tcl_RegExpMatchObj(interp, regExpr, objPtr, 0 /* offset */, + match = Tcl_RegExpExecObj(interp, regExpr, objPtr, 0 /* offset */, objc-2 /* nmatches */, eflags); if (match < 0) { @@ -330,13 +330,17 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) char *subspec; static char *options[] = { - "-all", "-nocase", "--", NULL + "-all", "-nocase", "-expanded", + "-line", "-linestop", "-lineanchor", + "--", NULL }; enum options { - REGSUB_ALL, REGSUB_NOCASE, REGSUB_LAST + REGSUB_ALL, REGSUB_NOCASE, REGSUB_EXPANDED, + REGSUB_LINE, REGSUB_LINESTOP, REGSUB_LINEANCHOR, + REGSUB_LAST }; - cflags = REG_ADVANCED; + cflags = TCL_REG_ADVANCED; all = 0; for (i = 1; i < objc; i++) { @@ -357,7 +361,23 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) break; } case REGSUB_NOCASE: { - cflags |= REG_ICASE; + cflags |= TCL_REG_NOCASE; + break; + } + case REGSUB_EXPANDED: { + cflags |= TCL_REG_EXPANDED; + break; + } + case REGSUB_LINE: { + cflags |= TCL_REG_NEWLINE; + break; + } + case REGSUB_LINESTOP: { + cflags |= TCL_REG_NLSTOP; + break; + } + case REGSUB_LINEANCHOR: { + cflags |= TCL_REG_NLANCH; break; } case REGSUB_LAST: { @@ -410,8 +430,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) * so that "^" won't match. */ - match = Tcl_RegExpMatchObj(interp, regExpr, objPtr, offset, - 10 /* matches */, ((offset > 0) ? REG_NOTBOL : 0)); + match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset, + 10 /* matches */, ((offset > 0) ? TCL_REG_NOTBOL : 0)); if (match < 0) { result = TCL_ERROR; @@ -2112,6 +2132,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) { int i, j, index, mode, matched, result; char *string, *pattern; + Tcl_Obj *stringObj; static char *options[] = { "-exact", "-glob", "-regexp", "--", NULL @@ -2143,7 +2164,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - string = Tcl_GetString(objv[i]); + stringObj = objv[i]; objc -= i + 1; objv += i + 1; @@ -2182,13 +2203,14 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) } else { switch (mode) { case OPT_EXACT: - matched = (strcmp(string, pattern) == 0); + matched = (strcmp(Tcl_GetString(stringObj), pattern) == 0); break; case OPT_GLOB: - matched = Tcl_StringMatch(string, pattern); + matched = Tcl_StringMatch(Tcl_GetString(stringObj), + pattern); break; case OPT_REGEXP: - matched = TclRegExpMatchObj(interp, string, objv[i]); + matched = Tcl_RegExpMatchObj(interp, stringObj, objv[i]); if (matched < 0) { return TCL_ERROR; } diff --git a/tests/regexp.test b/tests/regexp.test index c6c5b40..781cf24 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: regexp.test,v 1.5 1999/05/22 01:20:14 stanton Exp $ +# RCS: @(#) $Id: regexp.test,v 1.6 1999/06/17 19:31:50 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -317,35 +317,56 @@ test regexp-9.6 {-all option to regsub} { list [regsub -all ^ xxx 123 foo] $foo } {1 123xxx} -test regexp-10.1 {regsub errors} { +test regexp-10.1 {expanded syntax in regsub} { + set foo xxx + list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo +} {1 defc} +test regexp-10.2 {newline sensitivity in regsub} { + set foo xxx + list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo +} "1 {dabc\n123\n}" +test regexp-10.3 {newline sensitivity in regsub} { + set foo xxx + list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo +} "1 {dabc\n123\nxb}" +test regexp-10.4 {partial newline sensitivity in regsub} { + set foo xxx + list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo +} "1 {da\n123}" +test regexp-10.5 {inverse partial newline sensitivity in regsub} { + set foo xxx + list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo +} "1 {da\nb123\nxb}" + +test regexp-11.1 {regsub errors} { list [catch {regsub a b c} msg] $msg } {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}} -test regexp-10.2 {regsub errors} { +test regexp-11.2 {regsub errors} { list [catch {regsub -nocase a b c} msg] $msg } {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}} -test regexp-10.3 {regsub errors} { +test regexp-11.3 {regsub errors} { list [catch {regsub -nocase -all a b c} msg] $msg } {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}} -test regexp-10.4 {regsub errors} { +test regexp-11.4 {regsub errors} { list [catch {regsub a b c d e f} msg] $msg } {1 {wrong # args: should be "regsub ?switches? exp string subSpec varName"}} -test regexp-10.5 {regsub errors} { +test regexp-11.5 {regsub errors} { list [catch {regsub -gorp a b c} msg] $msg -} {1 {bad switch "-gorp": must be -all, -nocase, or --}} -test regexp-10.6 {regsub errors} { +} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, or --}} +test regexp-11.6 {regsub errors} { list [catch {regsub -nocase a( b c d} msg] $msg } {1 {couldn't compile regular expression pattern: parentheses () not balanced}} -test regexp-10.7 {regsub errors} { +test regexp-11.7 {regsub errors} { catch {unset f1} set f1 44 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg } {1 {couldn't set variable "f1(f2)"}} -test regexp-11.1 {Tcl_RegExpExec: large number of subexpressions} { +test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} { list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z } {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z} -test regexp-12.1 {regsub of a very large string} { +test regexp-13.1 {regsub of a very large string} { # This test is designed to stress the memory subsystem in order # to catch Bug #933. It only fails if the Tcl memory allocator # is in use. @@ -361,7 +382,7 @@ test regexp-12.1 {regsub of a very large string} { set x done } {done} -test regexp-13.1 {CompileRegexp: regexp cache} { +test regexp-14.1 {CompileRegexp: regexp cache} { regexp .*a b regexp .*b c regexp .*c d @@ -371,7 +392,7 @@ test regexp-13.1 {CompileRegexp: regexp cache} { append x *a regexp $x bbba } 1 -test regexp-13.2 {CompileRegexp: regexp cache, different flags} { +test regexp-14.2 {CompileRegexp: regexp cache, different flags} { regexp .*a b regexp .*b c regexp .*c d @@ -381,7 +402,7 @@ test regexp-13.2 {CompileRegexp: regexp cache, different flags} { append x *a regexp -nocase $x bbba } 1 -test regexp-13.3 {CompileRegexp: regexp cache, empty regexp and empty cache} { +test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} { makeFile {puts [regexp {} foo]} junk.tcl exec $tcltest junk.tcl } 1 @@ -405,3 +426,5 @@ return + + |