Commit | Line | Data |
---|---|---|
378cc40b LW |
1 | #!./perl |
2 | ||
fe14fcc3 LW |
3 | open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') |
4 | || die "Can't open re_tests"; | |
cfa4f241 | 5 | |
378cc40b LW |
6 | while (<TESTS>) { } |
7 | $numtests = $.; | |
cfa4f241 CS |
8 | seek(TESTS,0,0); |
9 | $. = 0; | |
378cc40b | 10 | |
1462b684 | 11 | $| = 1; |
cfa4f241 CS |
12 | print "1..$numtests\n"; |
13 | TEST: | |
378cc40b LW |
14 | while (<TESTS>) { |
15 | ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_); | |
16 | $input = join(':',$pat,$subject,$result,$repl,$expect); | |
1462b684 | 17 | $pat = "'$pat'" unless $pat =~ /^'/; |
cfa4f241 CS |
18 | for $study ("", "study \$match") { |
19 | eval "$study; \$match = (\$subject =~ m$pat); \$got = \"$repl\";"; | |
20 | if ($result eq 'c') { | |
21 | if ($@ eq '') { print "not ok $.\n"; next TEST } | |
22 | last; # no need to study a syntax error | |
23 | } | |
24 | elsif ($result eq 'n') { | |
25 | if ($match) { print "not ok $. $input => $got\n"; next TEST } | |
378cc40b LW |
26 | } |
27 | else { | |
cfa4f241 CS |
28 | if (!$match || $got ne $expect) { |
29 | print "not ok $. $input => $got\n"; | |
30 | next TEST; | |
31 | } | |
378cc40b LW |
32 | } |
33 | } | |
cfa4f241 | 34 | print "ok $.\n"; |
378cc40b | 35 | } |
cfa4f241 | 36 | |
378cc40b | 37 | close(TESTS); |