| 1 | #!./perl |
| 2 | |
| 3 | # The tests are in a separate file 't/op/re_tests'. |
| 4 | # Each line in that file is a separate test. |
| 5 | # There are five columns, separated by tabs. |
| 6 | # |
| 7 | # Column 1 contains the pattern, optionally enclosed in C<''>. |
| 8 | # Modifiers can be put after the closing C<'>. |
| 9 | # |
| 10 | # Column 2 contains the string to be matched. |
| 11 | # |
| 12 | # Column 3 contains the expected result: |
| 13 | # y expect a match |
| 14 | # n expect no match |
| 15 | # c expect an error |
| 16 | # B test exposes a known bug in Perl, should be skipped |
| 17 | # b test exposes a known bug in Perl, should be skipped if noamp |
| 18 | # |
| 19 | # Columns 4 and 5 are used only if column 3 contains C<y> or C<c>. |
| 20 | # |
| 21 | # Column 4 contains a string, usually C<$&>. |
| 22 | # |
| 23 | # Column 5 contains the expected result of double-quote |
| 24 | # interpolating that string after the match, or start of error message. |
| 25 | # |
| 26 | # Column 6, if present, contains a reason why the test is skipped. |
| 27 | # This is printed with "skipped", for harness to pick up. |
| 28 | # |
| 29 | # \n in the tests are interpolated, as are variables of the form ${\w+}. |
| 30 | # |
| 31 | # If you want to add a regular expression test that can't be expressed |
| 32 | # in this format, don't add it here: put it in op/pat.t instead. |
| 33 | |
| 34 | BEGIN { |
| 35 | chdir 't' if -d 't'; |
| 36 | @INC = '../lib'; |
| 37 | } |
| 38 | |
| 39 | $iters = shift || 1; # Poor man performance suite, 10000 is OK. |
| 40 | |
| 41 | open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || open(TESTS,':op:re_tests') || |
| 42 | die "Can't open re_tests"; |
| 43 | |
| 44 | while (<TESTS>) { } |
| 45 | $numtests = $.; |
| 46 | seek(TESTS,0,0); |
| 47 | $. = 0; |
| 48 | |
| 49 | $bang = sprintf "\\%03o", ord "!"; # \41 would not be portable. |
| 50 | $ffff = chr(0xff) x 2; |
| 51 | $nulnul = "\0" x 2; |
| 52 | |
| 53 | $| = 1; |
| 54 | print "1..$numtests\n# $iters iterations\n"; |
| 55 | TEST: |
| 56 | while (<TESTS>) { |
| 57 | chomp; |
| 58 | s/\\n/\n/g; |
| 59 | ($pat, $subject, $result, $repl, $expect, $reason) = split(/\t/,$_,6); |
| 60 | $input = join(':',$pat,$subject,$result,$repl,$expect); |
| 61 | infty_subst(\$pat); |
| 62 | infty_subst(\$expect); |
| 63 | $pat = "'$pat'" unless $pat =~ /^[:']/; |
| 64 | $pat =~ s/(\$\{\w+\})/$1/eeg; |
| 65 | $pat =~ s/\\n/\n/g; |
| 66 | $subject =~ s/(\$\{\w+\})/$1/eeg; |
| 67 | $subject =~ s/\\n/\n/g; |
| 68 | $expect =~ s/(\$\{\w+\})/$1/eeg; |
| 69 | $expect =~ s/\\n/\n/g; |
| 70 | $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/; |
| 71 | $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//)); |
| 72 | $reason = 'skipping $&' if $reason eq '' && $skip_amp; |
| 73 | $result =~ s/B//i unless $skip; |
| 74 | for $study ('', 'study \$subject') { |
| 75 | $c = $iters; |
| 76 | eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";"; |
| 77 | chomp( $err = $@ ); |
| 78 | if ($result eq 'c') { |
| 79 | if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST } |
| 80 | last; # no need to study a syntax error |
| 81 | } |
| 82 | elsif ( $skip ) { |
| 83 | print "ok $. # skipped", length($reason) ? " $reason" : '', "\n"; |
| 84 | next TEST; |
| 85 | } |
| 86 | elsif ($@) { |
| 87 | print "not ok $. $input => error `$err'\n"; next TEST; |
| 88 | } |
| 89 | elsif ($result eq 'n') { |
| 90 | if ($match) { print "not ok $. ($study) $input => false positive\n"; next TEST } |
| 91 | } |
| 92 | else { |
| 93 | if (!$match || $got ne $expect) { |
| 94 | print "not ok $. ($study) $input => `$got', match=$match\n"; |
| 95 | next TEST; |
| 96 | } |
| 97 | } |
| 98 | } |
| 99 | print "ok $.\n"; |
| 100 | } |
| 101 | |
| 102 | close(TESTS); |
| 103 | |
| 104 | sub infty_subst # Special-case substitution |
| 105 | { # of $reg_infty and friends |
| 106 | my $tp = shift; |
| 107 | $$tp =~ s/,\$reg_infty_m}/,$reg_infty_m}/o; |
| 108 | $$tp =~ s/,\$reg_infty_p}/,$reg_infty_p}/o; |
| 109 | $$tp =~ s/,\$reg_infty}/,$reg_infty}/o; |
| 110 | } |