This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Uninitialized tmbuf.
[perl5.git] / t / uni / class.t
CommitLineData
0f1b7392
RGS
1BEGIN {
2 chdir 't' if -d 't';
3 @INC = qw(../lib .);
4 require "test.pl";
5}
6
e22ae573
KW
7plan tests => 11;
8
9my $str = join "", map latin1_to_native(chr($_)), 0x20 .. 0x6F;
10
11is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO',
12 'user-defined class compiled before defined');
0f1b7392 13
d658a8a8 14sub IsMyUniClass {
0f1b7392
RGS
15 <<END;
160030 004F
17END
18}
19
d658a8a8 20sub Other::IsClass {
0f1b7392
RGS
21 <<END;
220040 005F
23END
24}
25
26sub A::B::Intersection {
27 <<END;
d658a8a8
DM
28+main::IsMyUniClass
29&Other::IsClass
0f1b7392
RGS
30END
31}
32
cd1c2c69
T
33sub 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
56use strict;
0f1b7392 57
0f1b7392
RGS
58# make sure it finds built-in class
59is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
12ac2576 60is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
0f1b7392
RGS
61
62# make sure it finds user-defined class
d658a8a8 63is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO');
0f1b7392
RGS
64
65# make sure it finds class in other package
d658a8a8 66is(($str =~ /(\p{Other::IsClass}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
0f1b7392
RGS
67
68# make sure it finds class in other OTHER package
69is(($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}";
75is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{0711}");
76is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{0711}");
77is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{0711}");
78is(($str =~ /(\P{bc=AL}+)/)[0], "\x{0711}");
12ac2576
JP
79
80# make sure InGreek works
81$str = "[\x{038B}\x{038C}\x{038D}]";
82
83is(($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