Commit | Line | Data |
---|---|---|
0f1b7392 RGS |
1 | BEGIN { |
2 | chdir 't' if -d 't'; | |
3 | @INC = qw(../lib .); | |
4 | require "test.pl"; | |
5 | } | |
6 | ||
e22ae573 KW |
7 | plan tests => 11; |
8 | ||
9 | my $str = join "", map latin1_to_native(chr($_)), 0x20 .. 0x6F; | |
10 | ||
11 | is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO', | |
12 | 'user-defined class compiled before defined'); | |
0f1b7392 | 13 | |
d658a8a8 | 14 | sub IsMyUniClass { |
0f1b7392 RGS |
15 | <<END; |
16 | 0030 004F | |
17 | END | |
18 | } | |
19 | ||
d658a8a8 | 20 | sub Other::IsClass { |
0f1b7392 RGS |
21 | <<END; |
22 | 0040 005F | |
23 | END | |
24 | } | |
25 | ||
26 | sub A::B::Intersection { | |
27 | <<END; | |
d658a8a8 DM |
28 | +main::IsMyUniClass |
29 | &Other::IsClass | |
0f1b7392 RGS |
30 | END |
31 | } | |
32 | ||
cd1c2c69 T |
33 | sub test_regexp ($$) { |
34 | # test that given string consists of N-1 chars matching $qr1, and 1 | |
35 | # char matching $qr2 | |
36 | my ($str, $blk) = @_; | |
37 | ||
38 | # constructing these objects here makes the last test loop go much faster | |
39 | my $qr1 = qr/(\p{$blk}+)/; | |
40 | if ($str =~ $qr1) { | |
41 | is($1, substr($str, 0, -1)); # all except last char | |
42 | } | |
43 | else { | |
44 | fail('first N-1 chars did not match'); | |
45 | } | |
46 | ||
47 | my $qr2 = qr/(\P{$blk}+)/; | |
48 | if ($str =~ $qr2) { | |
49 | is($1, substr($str, -1)); # only last char | |
50 | } | |
51 | else { | |
52 | fail('last char did not match'); | |
53 | } | |
54 | } | |
55 | ||
56 | use strict; | |
0f1b7392 | 57 | |
0f1b7392 RGS |
58 | # make sure it finds built-in class |
59 | is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); | |
12ac2576 | 60 | is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); |
0f1b7392 RGS |
61 | |
62 | # make sure it finds user-defined class | |
d658a8a8 | 63 | is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO'); |
0f1b7392 RGS |
64 | |
65 | # make sure it finds class in other package | |
d658a8a8 | 66 | is(($str =~ /(\p{Other::IsClass}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); |
0f1b7392 RGS |
67 | |
68 | # make sure it finds class in other OTHER package | |
69 | is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO'); | |
12ac2576 | 70 | |
484741e1 KW |
71 | # lib/unicore/lib/Bc/AL.pl. U+070E is unassigned, currently, but still has |
72 | # bidi class AL. The first one in the sequence that doesn't is 0711, which is | |
73 | # BC=NSM. | |
74 | $str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}\x{0712}"; | |
75 | is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{0711}"); | |
76 | is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{0711}"); | |
77 | is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{0711}"); | |
78 | is(($str =~ /(\P{bc=AL}+)/)[0], "\x{0711}"); | |
12ac2576 JP |
79 | |
80 | # make sure InGreek works | |
81 | $str = "[\x{038B}\x{038C}\x{038D}]"; | |
82 | ||
83 | is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}"); | |
cd1c2c69 | 84 | |
99870f4d | 85 | # The other tests that are based on looking at the generated files are now |
3df51b85 | 86 | # in t/re/uniprops.t |