| 85 |
|
|
| 86 |
# The private /+ modifier means "print $' afterwards". |
# The private /+ modifier means "print $' afterwards". |
| 87 |
|
|
| 88 |
$showrest = ($pattern =~ s/\+(?=[a-z]*$)//); |
$showrest = ($pattern =~ s/\+(?=[a-zA-Z]*$)//); |
| 89 |
|
|
| 90 |
# Remove /8 from a UTF-8 pattern. |
# Remove /8 from a UTF-8 pattern. |
| 91 |
|
|
| 92 |
$utf8 = $pattern =~ s/8(?=[a-z]*$)//; |
$utf8 = $pattern =~ s/8(?=[a-zA-Z]*$)//; |
| 93 |
|
|
| 94 |
|
# Remove /J from a pattern with duplicate names. |
| 95 |
|
|
| 96 |
|
$pattern =~ s/J(?=[a-zA-Z]*$)//; |
| 97 |
|
|
| 98 |
|
# Remove /K from a pattern (asks pcretest to check MARK data) */ |
| 99 |
|
|
| 100 |
|
$pattern =~ s/K(?=[a-zA-Z]*$)//; |
| 101 |
|
|
| 102 |
|
# Remove /W from a pattern (asks pcretest to set PCRE_UCP) |
| 103 |
|
|
| 104 |
|
$pattern =~ s/W(?=[a-zA-Z]*$)//; |
| 105 |
|
|
| 106 |
|
# Remove /S or /SS from a pattern (asks pcretest to study or not to study) |
| 107 |
|
|
| 108 |
|
$pattern =~ s/S(?=[a-zA-Z]*$)//g; |
| 109 |
|
|
| 110 |
# Check that the pattern is valid |
# Check that the pattern is valid |
| 111 |
|
|
| 139 |
chomp; |
chomp; |
| 140 |
printf $outfile "$_\n" if $infile ne "STDIN"; |
printf $outfile "$_\n" if $infile ne "STDIN"; |
| 141 |
|
|
| 142 |
s/\s+$//; |
s/\s+$//; # Remove trailing space |
| 143 |
s/^\s+//; |
s/^\s+//; # Remove leading space |
| 144 |
|
s/\\Y//g; # Remove \Y (pcretest flag to set PCRE_NO_START_OPTIMIZE) |
| 145 |
|
|
| 146 |
last if ($_ eq ""); |
last if ($_ eq ""); |
| 147 |
$x = eval "\"$_\""; # To get escapes processed |
$x = eval "\"$_\""; # To get escapes processed |
| 148 |
|
|
| 149 |
# Empty array for holding results, then do the matching. |
# Empty array for holding results, ensure $REGERROR and $REGMARK are |
| 150 |
|
# unset, then do the matching. |
| 151 |
|
|
| 152 |
@subs = (); |
@subs = (); |
| 153 |
|
|
| 170 |
"push \@subs,\$16;" . |
"push \@subs,\$16;" . |
| 171 |
"push \@subs,\$'; }"; |
"push \@subs,\$'; }"; |
| 172 |
|
|
| 173 |
|
undef $REGERROR; |
| 174 |
|
undef $REGMARK; |
| 175 |
|
|
| 176 |
eval "${cmd} (\$x =~ ${pattern}) {" . $pushes; |
eval "${cmd} (\$x =~ ${pattern}) {" . $pushes; |
| 177 |
|
|
| 178 |
if ($@) |
if ($@) |
| 182 |
} |
} |
| 183 |
elsif (scalar(@subs) == 0) |
elsif (scalar(@subs) == 0) |
| 184 |
{ |
{ |
| 185 |
printf $outfile "No match\n"; |
printf $outfile "No match"; |
| 186 |
|
if (defined $REGERROR && $REGERROR != 1) |
| 187 |
|
{ print $outfile (", mark = $REGERROR"); } |
| 188 |
|
printf $outfile "\n"; |
| 189 |
} |
} |
| 190 |
else |
else |
| 191 |
{ |
{ |
| 206 |
} |
} |
| 207 |
splice(@subs, 0, 18); |
splice(@subs, 0, 18); |
| 208 |
} |
} |
| 209 |
|
if (defined $REGMARK && $REGMARK != 1) |
| 210 |
|
{ print $outfile ("MK: $REGMARK\n"); } |
| 211 |
} |
} |
| 212 |
} |
} |
| 213 |
} |
} |