3 # Script for testing regular expressions with perl to check that PCRE2 handles
4 # them the same. If the first argument to this script is "-w", Perl is also
5 # called with "-w", which turns on its warning mode.
7 # The Perl code has to have "use utf8" and "require Encode" at the start when
8 # running UTF-8 tests, but *not* for non-utf8 tests. (The "require" would
9 # actually be OK for non-utf8-tests, but is not always installed, so this way
10 # the script will always run for these tests.)
12 # The desired effect is achieved by making this a shell script that passes the
13 # Perl script to Perl through a pipe. If the first argument (possibly after
14 # removing "-w") is "-utf8", a suitable prefix is set up.
16 # The remaining arguments, if any, are passed to Perl. They are an input file
17 # and an output file. If there is one argument, the output is written to
18 # STDOUT. If Perl receives no arguments, it opens /dev/tty as input, and writes
19 # output to STDOUT. (I haven't found a way of getting it to use STDIN, because
20 # of the contorted piping input.)
26 if [ $# -gt 0 -a "$1" = "-w" ] ; then
31 if [ $# -gt 0 -a "$1" = "-utf8" ] ; then
32 prefix="use utf8; require Encode;"
37 # The Perl script that follows has a similar specification to pcre2test, and so
38 # can be given identical input, except that input patterns can be followed only
39 # by Perl's lower case modifiers and certain other pcre2test modifiers that are
40 # either handled or ignored:
42 # aftertext interpreted as "print $' afterwards"
43 # afteralltext ignored
44 # dupnames ignored (Perl always allows)
46 # mark show mark information
47 # no_auto_possess ignored
48 # no_start_optimize insert (??{""}) at pattern start (disables optimizing)
49 # -no_start_optimize ignored
50 # subject_literal does not process subjects for escapes
51 # ucp sets Perl's /u modifier
52 # utf invoke UTF-8 functionality
54 # Comment lines are ignored. The #pattern command can be used to set modifiers
55 # that will be added to each subsequent pattern, after any modifiers it may
56 # already have. NOTE: this is different to pcre2test where #pattern sets
57 # defaults which can be overridden on individual patterns. The #subject command
58 # may be used to set or unset a default "mark" modifier for data lines. This is
59 # the only use of #subject that is supported. The #perltest, #forbid_utf, and
60 # #newline_default commands, which are needed in the relevant pcre2test files,
61 # are ignored. Any other #-command is ignored, with a warning message.
63 # The data lines must not have any pcre2test modifiers. Unless
64 # "subject_literal" is on the pattern, data lines are processed as
65 # Perl double-quoted strings, so if they contain " $ or @ characters, these
66 # have to be escaped. For this reason, all such characters in the
67 # Perl-compatible testinput1 and testinput4 files are escaped so that they can
68 # be used for perltest as well as for pcre2test. The output from this script
69 # should be same as from pcre2test, apart from the initial identifying banner.
71 # The other testinput files are not suitable for feeding to perltest.sh,
72 # because they make use of the special modifiers that pcre2test uses for
73 # testing features of PCRE2. Some of these files also contain malformed regular
74 # expressions, in order to check that PCRE2 diagnoses them correctly.
76 (echo "$prefix" ; cat <<'PERLEND'
78 # Function for turning a string into a string of printing chars.
84 @p = unpack('U*', $_[0]);
87 if ($c >= 32 && $c < 127) { $t .= chr $c; }
88 else { $t .= sprintf("\\x{%02x}", $c);
94 foreach $c (split(//, $_[0]))
96 if (ord $c >= 32 && ord $c < 127) { $t .= $c; }
97 else { $t .= sprintf("\\x%02x", ord $c); }
104 # Read lines from a named file or stdin and write to a named file or stdout;
105 # lines consist of a regular expression, in delimiters and optionally followed
106 # by options, followed by a set of test data, terminated by an empty line.
108 # Sort out the input and output files
112 open(INFILE, "<$ARGV[0]") || die "Failed to open $ARGV[0]\n";
118 open(INFILE, "</dev/tty") || die "Failed to open /dev/tty\n";
125 open(OUTFILE, ">$ARGV[1]") || die "Failed to open $ARGV[1]\n";
126 $outfile = "OUTFILE";
128 else { $outfile = "STDOUT"; }
130 printf($outfile "Perl $] Regular Expressions\n\n");
137 printf " re> " if $interact;
138 last if ! ($_ = <$infile>);
139 printf $outfile "$_" if ! $interact;
140 next if ($_ =~ /^\s*$/ || $_ =~ /^#[\s!]/);
142 # A few of pcre2test's #-commands are supported, or just ignored. Any others
145 if ($_ =~ /^#pattern(.*)/)
147 $extra_modifiers = $1;
148 chomp($extra_modifiers);
149 $extra_modifiers =~ s/\s+$//;
152 elsif ($_ =~ /^#subject(.*)/)
157 if ($mod =~ s/(-?)mark,?//)
160 $default_show_mark = ($minus =~ /^$/);
164 printf $outfile "** Warning: \"$mod\" in #subject ignored\n";
170 if ($_ !~ /^#newline_default|^#perltest|^#forbid_utf/)
172 printf $outfile "** Warning: #-command ignored: %s", $_;
179 while ($pattern !~ /^\s*(.).*\1/s)
181 printf " > " if $interact;
182 last if ! ($_ = <$infile>);
183 printf $outfile "$_" if ! $interact;
188 $pattern =~ s/\s+$//;
190 # Split the pattern from the modifiers and adjust them as necessary.
192 $pattern =~ /^\s*((.).*\2)(.*)$/s;
195 $mod = "$3,$extra_modifiers";
198 # The private "aftertext" modifier means "print $' afterwards".
200 $showrest = ($mod =~ s/aftertext,?//);
202 # The "subject_literal" modifer disables escapes in subjects.
204 $subject_literal = ($mod =~ s/subject_literal,?//);
206 # "allaftertext" is used by pcre2test to print remainders after captures
208 $mod =~ s/allaftertext,?//;
212 $utf8 = $mod =~ s/utf,?//;
216 $mod =~ s/dupnames,?//;
220 $mod =~ s/jitstack=\d+,?//;
222 # The "mark" modifier requests checking of MARK data */
224 $show_mark = $default_show_mark | ($mod =~ s/mark,?//);
226 # "ucp" asks pcre2test to set PCRE2_UCP; change this to /u for Perl
230 # Remove "no_auto_possess".
232 $mod =~ s/no_auto_possess,?//;
234 # Use no_start_optimize (disable PCRE2 start-up optimization) to disable Perl
235 # optimization by inserting (??{""}) at the start of the pattern. We may
236 # also encounter -no_start_optimize from a #pattern setting.
238 $mod =~ s/-no_start_optimize,?//;
239 if ($mod =~ s/no_start_optimize,?//) { $pat =~ s/$del/$del(??{""})/; }
241 # Add back retained modifiers and check that the pattern is valid.
244 $pattern = "$pat$mod";
245 eval "\$_ =~ ${pattern}";
248 printf $outfile "Error: $@";
253 last if ! ($_ = <$infile>);
254 last if $_ =~ /^\s*$/;
260 # If the /g modifier is present, we want to put a loop round the matching;
261 # otherwise just a single "if".
263 $cmd = ($pattern =~ /g[a-z]*$/)? "while" : "if";
265 # If the pattern is actually the null string, Perl uses the most recently
266 # executed (and successfully compiled) regex is used instead. This is a
267 # nasty trap for the unwary! The PCRE2 test suite does contain null strings
268 # in places - if they are allowed through here all sorts of weird and
269 # unexpected effects happen. To avoid this, we replace such patterns with
270 # a non-null pattern that has the same effect.
272 $pattern = "/(?#)/$2" if ($pattern =~ /^(.)\1(.*)$/);
274 # Read data lines and test them
278 printf "data> " if $interact;
279 last NEXT_RE if ! ($_ = <$infile>);
281 printf $outfile "%s", "$_\n" if ! $interact;
283 s/\s+$//; # Remove trailing space
284 s/^\s+//; # Remove leading space
287 next if $_ =~ /^\\=(?:\s|$)/; # Comment line
289 if ($subject_literal)
295 $x = eval "\"$_\""; # To get escapes processed
298 # Empty array for holding results, ensure $REGERROR and $REGMARK are
299 # unset, then do the matching.
303 $pushes = "push \@subs,\$&;" .
313 "push \@subs,\$10;" .
314 "push \@subs,\$11;" .
315 "push \@subs,\$12;" .
316 "push \@subs,\$13;" .
317 "push \@subs,\$14;" .
318 "push \@subs,\$15;" .
319 "push \@subs,\$16;" .
320 "push \@subs,\$'; }";
325 eval "${cmd} (\$x =~ ${pattern}) {" . $pushes;
329 printf $outfile "Error: $@\n";
332 elsif (scalar(@subs) == 0)
334 printf $outfile "No match";
335 if ($show_mark && defined $REGERROR && $REGERROR != 1)
336 { printf $outfile (", mark = %s", &pchars($REGERROR)); }
337 printf $outfile "\n";
341 while (scalar(@subs) != 0)
343 printf $outfile (" 0: %s\n", &pchars($subs[0]));
344 printf $outfile (" 0+ %s\n", &pchars($subs[17])) if $showrest;
346 for ($i = 1; $i <= 16; $i++)
348 if (defined $subs[$i])
350 while ($last_printed++ < $i-1)
351 { printf $outfile ("%2d: <unset>\n", $last_printed); }
352 printf $outfile ("%2d: %s\n", $i, &pchars($subs[$i]));
356 splice(@subs, 0, 18);
359 # It seems that $REGMARK is not marked as UTF-8 even when use utf8 is
360 # set and the input pattern was a UTF-8 string. We can, however, force
361 # it to be so marked.
363 if ($show_mark && defined $REGMARK && $REGMARK != 1)
366 $xx = Encode::decode_utf8($xx) if $utf8;
367 printf $outfile ("MK: %s\n", &pchars($xx));
373 # printf $outfile "\n";
376 ) | $perl $perlarg - $@