This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Minor cleanup of RE tests and docs
[perl5.git] / t / op / regexp.t
CommitLineData
378cc40b
LW
1#!./perl
2
9c63abab
GS
3# XXX known to leak scalars
4$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
eec2d3df 5
ad4f75a6
HM
6# The tests are in a separate file 't/op/re_tests'.
7# Each line in that file is a separate test.
8# There are five columns, separated by tabs.
9#
10# Column 1 contains the pattern, optionally enclosed in C<''>.
11# Modifiers can be put after the closing C<'>.
12#
13# Column 2 contains the string to be matched.
14#
15# Column 3 contains the expected result:
16# y expect a match
17# n expect no match
18# c expect an error
19#
1b1626e4 20# Columns 4 and 5 are used only if column 3 contains C<y> or C<c>.
ad4f75a6
HM
21#
22# Column 4 contains a string, usually C<$&>.
23#
24# Column 5 contains the expected result of double-quote
c277df42
IZ
25# interpolating that string after the match, or start of error message.
26#
9d116dd7 27# \n in the tests are interpolated, as are variables of the form ${\w+}.
83e898de 28#
8d37f932
DD
29# If you want to add a regular expression test that can't be expressed
30# in this format, don't add it here: put it in op/pat.t instead.
c277df42 31
e4d48cc9
GS
32BEGIN {
33 chdir 't' if -d 't';
34 @INC = '../lib' if -d '../lib';
35}
36
c277df42 37$iters = shift || 1; # Poor man performance suite, 10000 is OK.
ad4f75a6 38
8d37f932
DD
39open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') ||
40 die "Can't open re_tests";
cfa4f241 41
378cc40b
LW
42while (<TESTS>) { }
43$numtests = $.;
cfa4f241
CS
44seek(TESTS,0,0);
45$. = 0;
378cc40b 46
9d116dd7
JH
47$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
48
1462b684 49$| = 1;
c277df42 50print "1..$numtests\n# $iters iterations\n";
cfa4f241 51TEST:
378cc40b 52while (<TESTS>) {
b85d18e9
IZ
53 chomp;
54 s/\\n/\n/g;
55 ($pat, $subject, $result, $repl, $expect) = split(/\t/,$_);
378cc40b 56 $input = join(':',$pat,$subject,$result,$repl,$expect);
83e898de
DD
57 infty_subst(\$pat);
58 infty_subst(\$expect);
1b1626e4 59 $pat = "'$pat'" unless $pat =~ /^[:']/;
c277df42 60 $pat =~ s/\\n/\n/g;
9d116dd7 61 $pat =~ s/(\$\{\w+\})/$1/eeg;
c277df42
IZ
62 $subject =~ s/\\n/\n/g;
63 $expect =~ s/\\n/\n/g;
64 $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
ad4f75a6 65 for $study ("", "study \$subject") {
c277df42
IZ
66 $c = $iters;
67 eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
68 chomp( $err = $@ );
cfa4f241 69 if ($result eq 'c') {
c277df42 70 if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
cfa4f241
CS
71 last; # no need to study a syntax error
72 }
c277df42
IZ
73 elsif ($@) {
74 print "not ok $. $input => error `$err'\n"; next TEST;
75 }
cfa4f241 76 elsif ($result eq 'n') {
c277df42 77 if ($match) { print "not ok $. ($study) $input => false positive\n"; next TEST }
378cc40b
LW
78 }
79 else {
cfa4f241 80 if (!$match || $got ne $expect) {
c277df42 81 print "not ok $. ($study) $input => `$got', match=$match\n";
cfa4f241
CS
82 next TEST;
83 }
378cc40b
LW
84 }
85 }
cfa4f241 86 print "ok $.\n";
378cc40b 87}
cfa4f241 88
378cc40b 89close(TESTS);
83e898de
DD
90
91sub infty_subst # Special-case substitution
92{ # of $reg_infty and friends
93 my $tp = shift;
94 $$tp =~ s/,\$reg_infty_m}/,$reg_infty_m}/o;
95 $$tp =~ s/,\$reg_infty_p}/,$reg_infty_p}/o;
96 $$tp =~ s/,\$reg_infty}/,$reg_infty}/o;
97}