diff options
author | Ilya Zakharevich <ilya@math.berkeley.edu> | 1997-11-15 19:29:39 -0500 |
---|---|---|
committer | Malcolm Beattie <mbeattie@sable.ox.ac.uk> | 1997-11-19 11:04:15 +0000 |
commit | c277df42229d99fecbc76f5da53793a409ac66e1 (patch) | |
tree | de3cf73b51d3455f54655dc5b9fdaa68e3da9a7a /t/op/regexp.t | |
parent | 5d5aaa5e70a8a8ab4803cdb506e2096b6e190e80 (diff) | |
download | perl-c277df42229d99fecbc76f5da53793a409ac66e1.tar.gz |
Jumbo regexp patch applied (with minor fix-up tweaks):
Subject: Version 7 of Jumbo RE patch available
p4raw-id: //depot/perl@267
Diffstat (limited to 't/op/regexp.t')
-rwxr-xr-x | t/op/regexp.t | 25 |
1 files changed, 19 insertions, 6 deletions
diff --git a/t/op/regexp.t b/t/op/regexp.t index 803f1d0dab..273608433e 100755 --- a/t/op/regexp.t +++ b/t/op/regexp.t @@ -19,7 +19,11 @@ # Column 4 contains a string, usually C<$&>. # # Column 5 contains the expected result of double-quote -# interpolating that string after the match. +# interpolating that string after the match, or start of error message. +# +# Columns 1, 2 and 5 are \n-interpolated. + +$iters = shift || 1; # Poor man performance suite, 10000 is OK. open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || die "Can't open re_tests"; @@ -30,24 +34,33 @@ seek(TESTS,0,0); $. = 0; $| = 1; -print "1..$numtests\n"; +print "1..$numtests\n# $iters iterations\n"; TEST: while (<TESTS>) { ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_); $input = join(':',$pat,$subject,$result,$repl,$expect); $pat = "'$pat'" unless $pat =~ /^[:']/; + $pat =~ s/\\n/\n/g; + $subject =~ s/\\n/\n/g; + $expect =~ s/\\n/\n/g; + $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/; for $study ("", "study \$subject") { - eval "$study; \$match = (\$subject =~ m$pat); \$got = \"$repl\";"; + $c = $iters; + eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";"; + chomp( $err = $@ ); if ($result eq 'c') { - if ($@ !~ m!^\Q$expect!) { print "not ok $.\n"; next TEST } + if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST } last; # no need to study a syntax error } + elsif ($@) { + print "not ok $. $input => error `$err'\n"; next TEST; + } elsif ($result eq 'n') { - if ($match) { print "not ok $. $input => $got\n"; next TEST } + if ($match) { print "not ok $. ($study) $input => false positive\n"; next TEST } } else { if (!$match || $got ne $expect) { - print "not ok $. $input => $got\n"; + print "not ok $. ($study) $input => `$got', match=$match\n"; next TEST; } } |