summaryrefslogtreecommitdiff
path: root/t/op/regexp.t
diff options
context:
space:
mode:
authorChip Salzenberg <chip@perl.com>1997-02-20 10:43:28 +1200
committerChip Salzenberg <chip@atlantic.net>1997-02-22 04:41:00 +1200
commitcfa4f241474ab59f4e40e1ae0c286d51ff246f4a (patch)
tree70996aba3b55349168126e3001ef476f8daeaeca /t/op/regexp.t
parent14d597e277445d4fc3a245595c3609ec0c11a887 (diff)
downloadperl-cfa4f241474ab59f4e40e1ae0c286d51ff246f4a.tar.gz
Include 'study' in regexp.t
Diffstat (limited to 't/op/regexp.t')
-rwxr-xr-xt/op/regexp.t36
1 files changed, 19 insertions, 17 deletions
diff --git a/t/op/regexp.t b/t/op/regexp.t
index af8a66610d..c6969240fc 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -1,35 +1,37 @@
#!./perl
-# $RCSfile: regexp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:20 $
-
open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
|| die "Can't open re_tests";
+
while (<TESTS>) { }
$numtests = $.;
-close(TESTS);
+seek(TESTS,0,0);
+$. = 0;
-print "1..$numtests\n";
-open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
- || die "Can't open re_tests";
$| = 1;
+print "1..$numtests\n";
+TEST:
while (<TESTS>) {
($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_);
$input = join(':',$pat,$subject,$result,$repl,$expect);
$pat = "'$pat'" unless $pat =~ /^'/;
- eval "\$match = (\$subject =~ m$pat); \$got = \"$repl\";";
- if ($result eq 'c') {
- if ($@ ne '') {print "ok $.\n";} else {print "not ok $.\n";}
- }
- elsif ($result eq 'n') {
- if (!$match) {print "ok $.\n";} else {print "not ok $. $input => $got\n";}
- }
- else {
- if ($match && $got eq $expect) {
- print "ok $.\n";
+ for $study ("", "study \$match") {
+ eval "$study; \$match = (\$subject =~ m$pat); \$got = \"$repl\";";
+ if ($result eq 'c') {
+ if ($@ eq '') { print "not ok $.\n"; next TEST }
+ last; # no need to study a syntax error
+ }
+ elsif ($result eq 'n') {
+ if ($match) { print "not ok $. $input => $got\n"; next TEST }
}
else {
- print "not ok $. $input => $got\n";
+ if (!$match || $got ne $expect) {
+ print "not ok $. $input => $got\n";
+ next TEST;
+ }
}
}
+ print "ok $.\n";
}
+
close(TESTS);