Commit | Line | Data |
0f1b7392 |
1 | BEGIN { |
2 | chdir 't' if -d 't'; |
3 | @INC = qw(../lib .); |
4 | require "test.pl"; |
5 | } |
6 | |
99870f4d |
7 | plan tests => 10; |
0f1b7392 |
8 | |
9 | sub MyUniClass { |
10 | <<END; |
11 | 0030 004F |
12 | END |
13 | } |
14 | |
15 | sub Other::Class { |
16 | <<END; |
17 | 0040 005F |
18 | END |
19 | } |
20 | |
21 | sub A::B::Intersection { |
22 | <<END; |
23 | +main::MyUniClass |
24 | &Other::Class |
25 | END |
26 | } |
27 | |
cd1c2c69 |
28 | sub test_regexp ($$) { |
29 | # test that given string consists of N-1 chars matching $qr1, and 1 |
30 | # char matching $qr2 |
31 | my ($str, $blk) = @_; |
32 | |
33 | # constructing these objects here makes the last test loop go much faster |
34 | my $qr1 = qr/(\p{$blk}+)/; |
35 | if ($str =~ $qr1) { |
36 | is($1, substr($str, 0, -1)); # all except last char |
37 | } |
38 | else { |
39 | fail('first N-1 chars did not match'); |
40 | } |
41 | |
42 | my $qr2 = qr/(\P{$blk}+)/; |
43 | if ($str =~ $qr2) { |
44 | is($1, substr($str, -1)); # only last char |
45 | } |
46 | else { |
47 | fail('last char did not match'); |
48 | } |
49 | } |
50 | |
51 | use strict; |
0f1b7392 |
52 | |
250d67eb |
53 | my $str; |
54 | |
55 | if (ord('A') == 193) { |
56 | $str = join "", map chr($_), 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, 0xF0 .. 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, 0x7C, 0xC1 .. 0xC9, 0xD1 .. 0xD9, 0xE2 .. 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, 0x79, 0x81 .. 0x89, 0x91 .. 0x96; # IBM-1047 |
57 | } else { |
58 | $str = join "", map chr($_), 0x20 .. 0x6F; |
59 | } |
0f1b7392 |
60 | |
61 | # make sure it finds built-in class |
62 | is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); |
12ac2576 |
63 | is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); |
0f1b7392 |
64 | |
65 | # make sure it finds user-defined class |
66 | is(($str =~ /(\p{MyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO'); |
67 | |
68 | # make sure it finds class in other package |
69 | is(($str =~ /(\p{Other::Class}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); |
70 | |
71 | # make sure it finds class in other OTHER package |
72 | is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO'); |
12ac2576 |
73 | |
3df51b85 |
74 | # lib/unicore/Bc/AL.pl |
12ac2576 |
75 | $str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}"; |
99870f4d |
76 | is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{070F}"); |
77 | is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{070F}"); |
78 | is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{070F}"); |
79 | is(($str =~ /(\P{bc=AL}+)/)[0], "\x{070F}"); |
12ac2576 |
80 | |
81 | # make sure InGreek works |
82 | $str = "[\x{038B}\x{038C}\x{038D}]"; |
83 | |
84 | is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}"); |
cd1c2c69 |
85 | |
99870f4d |
86 | # The other tests that are based on looking at the generated files are now |
3df51b85 |
87 | # in t/re/uniprops.t |