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 | |
8a38a836 |
53 | my $str = join "", map latin1_to_native(chr($_)), 0x20 .. 0x6F; |
0f1b7392 |
54 | |
55 | # make sure it finds built-in class |
56 | is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); |
12ac2576 |
57 | is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); |
0f1b7392 |
58 | |
59 | # make sure it finds user-defined class |
60 | is(($str =~ /(\p{MyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO'); |
61 | |
62 | # make sure it finds class in other package |
63 | is(($str =~ /(\p{Other::Class}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); |
64 | |
65 | # make sure it finds class in other OTHER package |
66 | is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO'); |
12ac2576 |
67 | |
3df51b85 |
68 | # lib/unicore/Bc/AL.pl |
12ac2576 |
69 | $str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}"; |
99870f4d |
70 | is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{070F}"); |
71 | is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{070F}"); |
72 | is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{070F}"); |
73 | is(($str =~ /(\P{bc=AL}+)/)[0], "\x{070F}"); |
12ac2576 |
74 | |
75 | # make sure InGreek works |
76 | $str = "[\x{038B}\x{038C}\x{038D}]"; |
77 | |
78 | is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}"); |
cd1c2c69 |
79 | |
99870f4d |
80 | # The other tests that are based on looking at the generated files are now |
3df51b85 |
81 | # in t/re/uniprops.t |