This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add t/re/anyof.t
authorKarl Williamson <khw@cpan.org>
Mon, 11 Jul 2016 17:54:56 +0000 (11:54 -0600)
committerKarl Williamson <khw@cpan.org>
Sat, 16 Jul 2016 23:42:38 +0000 (17:42 -0600)
The ANYOF regnode is by far the most complicated to compile in regular
expression patterns.  This new test file makes sure that what gets
compiled doesn't get changed accidentally, nor how the compiled node is
dumped for human readable output.

I created tests for this from what changed in
b77aba85f6ec3b2a2341077b14f39261c5753cea
"Revamp -Dr handling of /[...]/", and from trying to exercise all
branches in it using gcov.

Making this test file showed some bugs, and infelicitous representations
from that commit, which will be fixed in the next few commits, and tests
added as each change is done.

MANIFEST
t/re/anyof.t [new file with mode: 0644]

index 05933a9..773835f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5617,6 +5617,7 @@ t/porting/regen.t         Check that regen.pl doesn't need running
 t/porting/ss_dup.t             Check that sv.c:ss_dup handle everything
 t/porting/test_bootstrap.t     Test that the instructions for test bootstrapping aren't accidentally overlooked.
 t/porting/utils.t              Check that utility scripts still compile
+t/re/anyof.t                   See if bracketed char classes [...] compile properly
 t/re/charset.t                 See if regex modifiers like /d, /u work properly
 t/re/fold_grind.t              See if case folding works properly
 t/re/no_utf8_pm.t              Verify utf8.pm doesn't get loaded unless required
diff --git a/t/re/anyof.t b/t/re/anyof.t
new file mode 100644 (file)
index 0000000..181028d
--- /dev/null
@@ -0,0 +1,108 @@
+use utf8;
+
+# This tests that the ANYOF nodes generated by bracketed character classes are
+# as expected.  The representation of these is not guaranteed, and this test
+# may need to be updated if it changes.  But it is here to make sure that no
+# unexpected changes occur.  These could come from faulty generation of the
+# node, or faulty display of them (or both).  Because these causes come from
+# very different parts of the regex compiler, it is unlikely that a commit
+# would change both of them, so this test will adequately serve to test both.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('../lib','.','../ext/re');
+    require Config; import Config;
+    require './test.pl';
+    skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
+}
+
+# An array is used instead of a hash, so that the tests are carried out in the
+# order given by this file.  Even-numbered indices are the regexes to compile.
+# The next higher element is the expected compilation result.
+#
+# It is painful to port some of these to EBCDIC, as not only do the code point
+# numbers change (for those < 256), but the order changes, as the compiled
+# version is sorted by native code point order.  On EBCDIC, \r comes before
+# \n, and 'k' before "K', for example.  So, the tests where there are
+# differences are skipped on EBCDIC.  They are all at the beginning of the
+# array, and a special marker entry is used to delmit the boundary between
+# skipped and not skipped.
+
+my @tests = (
+    '[[{]' => 'ANYOF[[\{]',
+    '[^\n\r]' => 'ANYOF[^\n\r][0100-INFINITY]',
+    '[^\/\|,\$\%%\@\ \%"\<\>\:\#\&\*\{\}\[\]\(\)]' => 'ANYOF[^ "#$%&()*,/:<>@[\]\{|\}][0100-INFINITY]',
+    '[ [:blank:]]' => 'ANYOFD[\t {utf8}\xA0][1680 2000-200A 202F 205F 3000]',
+    '[\xA0[:^blank:]]' => 'ANYOF[^\t ][0100-167F 1681-1FFF 200B-202E 2030-205E 2060-2FFF 3001-INFINITY]',
+    '(?il:[\x{212A}])' => 'ANYOFL{i}[{utf8 locale}Kk][212A]',
+    '(?il:(?[\x{212A}]))' => 'ANYOFL{utf8-locale-reqd}[Kk][212A]',
+
+    'ebcdic_ok_below_this_marker',
+
+    '(?l:[\x{212A}])' => 'ANYOFL[212A]',
+    '(?l:[\s\x{212A}])' => 'ANYOFL[\s][1680 2000-200A 2028-2029 202F 205F 212A 3000]',
+    '(?l:[^\S\x{202F}])' => 'ANYOFL[^\\S][1680 2000-200A 2028-2029 205F 3000]',
+    '(?i:[^:])' => 'ANYOF[^:][0100-INFINITY]',
+);
+
+# 2**32-1 or 2**64-1
+my $highest_cp_string = "F" x (($Config{uvsize} < 8) ? 8 : 16);
+
+my $next_highest_cp_string = $highest_cp_string =~ s/ F $ /E/xr;
+
+my $highest_cp = "\\x{$highest_cp_string}";
+my $next_highest_cp = "\\x{$next_highest_cp_string}";
+
+plan(scalar (@tests - 1) / 2);  # -1 because of the marker.
+
+my $skip_ebcdic = $::IS_EBCDIC;
+while (defined (my $test = shift @tests)) {
+
+    if ($test eq 'ebcdic_ok_below_this_marker') {
+        $skip_ebcdic = 0;
+        next;
+    }
+
+    my $expected = shift @tests;
+
+    SKIP: {
+        skip("test not ported to EBCDIC", 1) if $skip_ebcdic;
+
+        my $display_expected = $expected
+                                  =~ s/ INFINITY_minus_1 /$next_highest_cp/xgr;
+
+        # Convert platform-independent values to what is suitable for the
+        # platform
+        $test =~ s/{INFINITY}/$highest_cp/g;
+        $test =~ s/{INFINITY_minus_1}/$next_highest_cp/g;
+
+        $test = "qr/$test/";
+        my $actual_test = "use re qw(Debug COMPILE); $test";
+
+        my $result = fresh_perl($actual_test);
+        if ($? != 0) {  # Re-run so as to display STDERR.
+            fail($test);
+            fresh_perl($actual_test, { stderr => 0, verbose => 1 });
+            next;
+        }
+
+        # The Debug output will come back as a bunch of lines.  We are
+        # interested only in the line after /Final program/
+        my @lines = split /\n/, $result;
+        while (defined ($_ = shift @lines)) {
+            next unless /Final program/;
+            $_ = shift @lines;
+
+            s/ \s* \( \d+ \) \s* //x;   # Get rid of the node branch
+            s/ ^ \s* \d+ : \s* //x;     # ... And the node number
+
+            # Use platform-independent values
+            s/$highest_cp_string/INFINITY/g;
+            s/$next_highest_cp_string/INFINITY_minus_1/g;
+
+            is($_, $expected,
+               "Verify compilation of $test displays as $display_expected");
+            last;   # Discard the rest of this test's output
+        }
+    }
+}