summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclCmdIL.c8
-rw-r--r--generic/tclCmdMZ.c58
-rw-r--r--tests/regexp.test51
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
+
+