t/op/regexp.t

   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 #
  17 # Columns 4 and 5 are used only of column 3 contains C<y>.
  18 #
  19 # Column 4 contains a string, usually C<$&>.
  20 #
  21 # Column 5 contains the expected result of double-quote
  22 # interpolating that string after the match.
  23
  24 open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
  25     || die "Can't open re_tests";
  26
  27 while (<TESTS>) { }
  28 $numtests = $.;
  29 seek(TESTS,0,0);
  30 $. = 0;
  31
  32 $| = 1;
  33 print "1..$numtests\n";
  34 TEST:
  35 while (<TESTS>) {
  36     ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_);
  37     $input = join(':',$pat,$subject,$result,$repl,$expect);
  38     $pat = "'$pat'" unless $pat =~ /^'/;
  39     for $study ("", "study \$subject") {
  40         eval "$study; \$match = (\$subject =~ m$pat); \$got = \"$repl\";";
  41         if ($result eq 'c') {
  42             if ($@ eq '') { print "not ok $.\n"; next TEST }
  43             last;  # no need to study a syntax error
  44         }
  45         elsif ($result eq 'n') {
  46             if ($match) { print "not ok $. $input => $got\n"; next TEST }
  47         }
  48         else {
  49             if (!$match || $got ne $expect) {
  50                 print "not ok $. $input => $got\n";
  51                 next TEST;
  52             }
  53         }
  54     }
  55     print "ok $.\n";
  56 }
  57
  58 close(TESTS);