/[pcre]/code/trunk/perltest.pl
ViewVC logotype

Diff of /code/trunk/perltest.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 835 by ph10, Wed Dec 28 16:10:09 2011 UTC revision 903 by ph10, Sat Jan 21 16:37:17 2012 UTC
# Line 1  Line 1 
1  #! /usr/bin/env perl  #! /usr/bin/env perl
2    
3  # Program for testing regular expressions with perl to check that PCRE handles  # Program for testing regular expressions with perl to check that PCRE handles
4  # them the same. This is the version that supports /8 for UTF-8 testing. As it  # them the same. This version supports /8 for UTF-8 testing. However, it needs
5  # stands, it requires at least Perl 5.8 for UTF-8 support. However, it needs to  # to have "use utf8" at the start for running the UTF-8 tests, but *not* for
6  # have "use utf8" at the start for running the UTF-8 tests, but *not* for the  # the other tests. The only way I've found for doing this is to cat this line
7  # other tests. The only way I've found for doing this is to cat this line in  # in explicitly in the RunPerlTest script. I've also used this method to supply
8  # explicitly in the RunPerlTest script.  # "require Encode" for the UTF-8 tests, so that the main test will still run
9    # where Encode is not installed.
10    
11  # use locale;  # With this included, \x0b matches \s!  # use locale;  # With this included, \x0b matches \s!
12    
13  # Function for turning a string into a string of printing chars. There are  # Function for turning a string into a string of printing chars.
14  # currently problems with UTF-8 strings; this fudges round them.  
15    #require Encode;
16    
17  sub pchars {  sub pchars {
18  my($t) = "";  my($t) = "";
# Line 21  if ($utf8) Line 23  if ($utf8)
23    foreach $c (@p)    foreach $c (@p)
24      {      {
25      if ($c >= 32 && $c < 127) { $t .= chr $c; }      if ($c >= 32 && $c < 127) { $t .= chr $c; }
26        else { $t .= sprintf("\\x{%02x}", $c); }        else { $t .= sprintf("\\x{%02x}", $c);
27          }
28      }      }
29    }    }
   
30  else  else
31    {    {
32    foreach $c (split(//, $_[0]))    foreach $c (split(//, $_[0]))
# Line 111  for (;;) Line 113  for (;;)
113    
114    $pattern =~ s/S(?=[a-zA-Z]*$)//g;    $pattern =~ s/S(?=[a-zA-Z]*$)//g;
115    
116      # Remove /Y from a pattern (asks pcretest to disable PCRE optimization)
117    
118      $pattern =~ s/Y(?=[a-zA-Z]*$)//;
119    
120    # Check that the pattern is valid    # Check that the pattern is valid
121    
122    eval "\$_ =~ ${pattern}";    eval "\$_ =~ ${pattern}";
# Line 188  for (;;) Line 194  for (;;)
194        {        {
195        printf $outfile "No match";        printf $outfile "No match";
196        if (defined $REGERROR && $REGERROR != 1)        if (defined $REGERROR && $REGERROR != 1)
197          { print $outfile (", mark = $REGERROR"); }          { printf $outfile (", mark = %s", &pchars($REGERROR)); }
198        printf $outfile "\n";        printf $outfile "\n";
199        }        }
200      else      else
# Line 210  for (;;) Line 216  for (;;)
216            }            }
217          splice(@subs, 0, 18);          splice(@subs, 0, 18);
218          }          }
219    
220          # It seems that $REGMARK is not marked as UTF-8 even when use utf8 is
221          # set and the input pattern was a UTF-8 string. We can, however, force
222          # it to be so marked.
223    
224        if (defined $REGMARK && $REGMARK != 1)        if (defined $REGMARK && $REGMARK != 1)
225          { print $outfile ("MK: $REGMARK\n"); }          {
226            $xx = $REGMARK;
227            $xx = Encode::decode_utf8($xx) if $utf8;
228            printf $outfile ("MK: %s\n", &pchars($xx));
229            }
230        }        }
231      }      }
232    }    }

Legend:
Removed from v.835  
changed lines
  Added in v.903

  ViewVC Help
Powered by ViewVC 1.1.5