This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
2980cc8273f58aa03dde20787dab6fa5273e8201
[perl5.git] / t / re / anyof.t
1 use utf8;
2
3 # This tests that the ANYOF nodes generated by bracketed character classes are
4 # as expected.  The representation of these is not guaranteed, and this test
5 # may need to be updated if it changes.  But it is here to make sure that no
6 # unexpected changes occur.  These could come from faulty generation of the
7 # node, or faulty display of them (or both).  Because these causes come from
8 # very different parts of the regex compiler, it is unlikely that a commit
9 # would change both of them, so this test will adequately serve to test both.
10
11 BEGIN {
12     chdir 't' if -d 't';
13     @INC = ('../lib','.','../ext/re');
14     require Config; import Config;
15     require './test.pl';
16     skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
17 }
18
19 # An array is used instead of a hash, so that the tests are carried out in the
20 # order given by this file.  Even-numbered indices are the regexes to compile.
21 # The next higher element is the expected compilation result.
22 #
23 # It is painful to port some of these to EBCDIC, as not only do the code point
24 # numbers change (for those < 256), but the order changes, as the compiled
25 # version is sorted by native code point order.  On EBCDIC, \r comes before
26 # \n, and 'k' before "K', for example.  So, the tests where there are
27 # differences are skipped on EBCDIC.  They are all at the beginning of the
28 # array, and a special marker entry is used to delmit the boundary between
29 # skipped and not skipped.
30
31 my @tests = (
32     '[[{]' => 'ANYOF[[\{]',
33     '[^\n\r]' => 'ANYOF[^\n\r][0100-INFINITY]',
34     '[^\/\|,\$\%%\@\ \%"\<\>\:\#\&\*\{\}\[\]\(\)]' => 'ANYOF[^ "#$%&()*,/:<>@[\]\{|\}][0100-INFINITY]',
35     '[ [:blank:]]' => 'ANYOFD[\t {utf8}\xA0][1680 2000-200A 202F 205F 3000]',
36     '[\xA0[:^blank:]]' => 'ANYOF[^\t ][0100-167F 1681-1FFF 200B-202E 2030-205E 2060-2FFF 3001-INFINITY]',
37     '(?il:[\x{212A}])' => 'ANYOFL{i}[{utf8 locale}Kk][212A]',
38     '(?il:(?[\x{212A}]))' => 'ANYOFL{utf8-locale-reqd}[Kk][212A]',
39
40     'ebcdic_ok_below_this_marker',
41
42     '(?l:[\x{212A}])' => 'ANYOFL[212A]',
43     '(?l:[\s\x{212A}])' => 'ANYOFL[\s][1680 2000-200A 2028-2029 202F 205F 212A 3000]',
44     '(?l:[^\S\x{202F}])' => 'ANYOFL[^\\S][1680 2000-200A 2028-2029 205F 3000]',
45     '(?i:[^:])' => 'ANYOF[^:][0100-INFINITY]',
46     '[\p{Any}]' => 'ANYOF[\x00-\xFF][0100-10FFFF]',
47     '[\p{IsMyRuntimeProperty}]' => 'ANYOF[+utf8::IsMyRuntimeProperty]',
48     '[^\p{IsMyRuntimeProperty}]' => 'ANYOF[^{+utf8::IsMyRuntimeProperty}]',
49     '[a\p{IsMyRuntimeProperty}]' => 'ANYOF[a][+utf8::IsMyRuntimeProperty]',
50     '[^a\p{IsMyRuntimeProperty}]' => 'ANYOF[^a{+utf8::IsMyRuntimeProperty}]',
51     '[^a\x{100}\p{IsMyRuntimeProperty}]' => 'ANYOF[^a{+utf8::IsMyRuntimeProperty}0100]',
52 );
53
54 # 2**32-1 or 2**64-1
55 my $highest_cp_string = "F" x (($Config{uvsize} < 8) ? 8 : 16);
56
57 my $next_highest_cp_string = $highest_cp_string =~ s/ F $ /E/xr;
58
59 my $highest_cp = "\\x{$highest_cp_string}";
60 my $next_highest_cp = "\\x{$next_highest_cp_string}";
61
62 plan(scalar (@tests - 1) / 2);  # -1 because of the marker.
63
64 my $skip_ebcdic = $::IS_EBCDIC;
65 while (defined (my $test = shift @tests)) {
66
67     if ($test eq 'ebcdic_ok_below_this_marker') {
68         $skip_ebcdic = 0;
69         next;
70     }
71
72     my $expected = shift @tests;
73
74     SKIP: {
75         skip("test not ported to EBCDIC", 1) if $skip_ebcdic;
76
77         my $display_expected = $expected
78                                   =~ s/ INFINITY_minus_1 /$next_highest_cp/xgr;
79
80         # Convert platform-independent values to what is suitable for the
81         # platform
82         $test =~ s/{INFINITY}/$highest_cp/g;
83         $test =~ s/{INFINITY_minus_1}/$next_highest_cp/g;
84
85         $test = "qr/$test/";
86         my $actual_test = "use re qw(Debug COMPILE); $test";
87
88         my $result = fresh_perl($actual_test);
89         if ($? != 0) {  # Re-run so as to display STDERR.
90             fail($test);
91             fresh_perl($actual_test, { stderr => 0, verbose => 1 });
92             next;
93         }
94
95         # The Debug output will come back as a bunch of lines.  We are
96         # interested only in the line after /Final program/
97         my @lines = split /\n/, $result;
98         while (defined ($_ = shift @lines)) {
99             next unless /Final program/;
100             $_ = shift @lines;
101
102             s/ \s* \( \d+ \) \s* //x;   # Get rid of the node branch
103             s/ ^ \s* \d+ : \s* //x;     # ... And the node number
104
105             # Use platform-independent values
106             s/$highest_cp_string/INFINITY/g;
107             s/$next_highest_cp_string/INFINITY_minus_1/g;
108
109             is($_, $expected,
110                "Verify compilation of $test displays as $display_expected");
111             last;   # Discard the rest of this test's output
112         }
113     }
114 }