mirror of
https://github.com/php/php-src.git
synced 2024-10-05 16:56:11 +00:00
144 lines
2.9 KiB
Perl
Executable File
144 lines
2.9 KiB
Perl
Executable File
#! /usr/bin/perl
|
|
|
|
# Program for testing regular expressions with perl to check that PCRE handles
|
|
# them the same.
|
|
|
|
|
|
# Function for turning a string into a string of printing chars
|
|
|
|
sub pchars {
|
|
my($t) = "";
|
|
|
|
foreach $c (split(//, @_[0]))
|
|
{
|
|
if (ord $c >= 32 && ord $c < 127) { $t .= $c; }
|
|
else { $t .= sprintf("\\x%02x", ord $c); }
|
|
}
|
|
$t;
|
|
}
|
|
|
|
|
|
|
|
# Read lines from named file or stdin and write to named file or stdout; lines
|
|
# consist of a regular expression, in delimiters and optionally followed by
|
|
# options, followed by a set of test data, terminated by an empty line.
|
|
|
|
# Sort out the input and output files
|
|
|
|
if (@ARGV > 0)
|
|
{
|
|
open(INFILE, "<$ARGV[0]") || die "Failed to open $ARGV[0]\n";
|
|
$infile = "INFILE";
|
|
}
|
|
else { $infile = "STDIN"; }
|
|
|
|
if (@ARGV > 1)
|
|
{
|
|
open(OUTFILE, ">$ARGV[1]") || die "Failed to open $ARGV[1]\n";
|
|
$outfile = "OUTFILE";
|
|
}
|
|
else { $outfile = "STDOUT"; }
|
|
|
|
printf($outfile "Perl $] Regular Expressions\n\n");
|
|
|
|
# Main loop
|
|
|
|
NEXT_RE:
|
|
for (;;)
|
|
{
|
|
printf " re> " if $infile eq "STDIN";
|
|
last if ! ($_ = <$infile>);
|
|
printf $outfile "$_" if $infile ne "STDIN";
|
|
next if ($_ eq "");
|
|
|
|
$pattern = $_;
|
|
|
|
$delimiter = substr($_, 0, 1);
|
|
while ($pattern !~ /^\s*(.).*\1/s)
|
|
{
|
|
printf " > " if $infile eq "STDIN";
|
|
last if ! ($_ = <$infile>);
|
|
printf $outfile "$_" if $infile ne "STDIN";
|
|
$pattern .= $_;
|
|
}
|
|
|
|
chomp($pattern);
|
|
$pattern =~ s/\s+$//;
|
|
|
|
# Check that the pattern is valid
|
|
|
|
eval "\$_ =~ ${pattern}";
|
|
if ($@)
|
|
{
|
|
printf $outfile "Error: $@";
|
|
next NEXT_RE;
|
|
}
|
|
|
|
# Read data lines and test them
|
|
|
|
for (;;)
|
|
{
|
|
printf "data> " if $infile eq "STDIN";
|
|
last NEXT_RE if ! ($_ = <$infile>);
|
|
chomp;
|
|
printf $outfile "$_\n" if $infile ne "STDIN";
|
|
|
|
s/\s+$//;
|
|
s/^\s+//;
|
|
|
|
last if ($_ eq "");
|
|
|
|
$_ = eval "\"$_\""; # To get escapes processed
|
|
|
|
$ok = 0;
|
|
eval "if (\$_ =~ ${pattern}) {" .
|
|
"\$z = \$&;" .
|
|
"\$a = \$1;" .
|
|
"\$b = \$2;" .
|
|
"\$c = \$3;" .
|
|
"\$d = \$4;" .
|
|
"\$e = \$5;" .
|
|
"\$f = \$6;" .
|
|
"\$g = \$7;" .
|
|
"\$h = \$8;" .
|
|
"\$i = \$9;" .
|
|
"\$j = \$10;" .
|
|
"\$k = \$11;" .
|
|
"\$l = \$12;" .
|
|
"\$m = \$13;" .
|
|
"\$n = \$14;" .
|
|
"\$o = \$15;" .
|
|
"\$p = \$16;" .
|
|
"\$ok = 1; }";
|
|
|
|
if ($@)
|
|
{
|
|
printf $outfile "Error: $@\n";
|
|
next NEXT_RE;
|
|
}
|
|
elsif (!$ok)
|
|
{
|
|
printf $outfile "No match\n";
|
|
}
|
|
else
|
|
{
|
|
@subs = ($z,$a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p);
|
|
$last_printed = 0;
|
|
for ($i = 0; $i <= 17; $i++)
|
|
{
|
|
if ($i == 0 || defined $subs[$i])
|
|
{
|
|
while ($last_printed++ < $i-1)
|
|
{ printf $outfile ("%2d: <unset>\n", $last_printed); }
|
|
printf $outfile ("%2d: %s\n", $i, &pchars($subs[$i]));
|
|
$last_printed = $i;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
printf $outfile "\n";
|
|
|
|
# End
|