This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5db: add tests for v command
[perl5.git] / t / uni / class.t
CommitLineData
0f1b7392
RGS
1BEGIN {
2 chdir 't' if -d 't';
a9137859 3 require './test.pl';
43ece5b1 4 set_up_inc(qw(../lib .));
2b08d1e2 5 skip_all_without_unicode_tables();
0f1b7392
RGS
6}
7
4531f512 8plan tests => 12;
e22ae573 9
6deb7a5e 10my $str = join "", map { chr utf8::unicode_to_native($_) } 0x20 .. 0x6F;
e22ae573
KW
11
12is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO',
13 'user-defined class compiled before defined');
0f1b7392 14
d658a8a8 15sub IsMyUniClass {
df6c5b1f
KW
16 my $return = "";
17 for my $i (0x30 .. 0x4F) {
18 $return .= sprintf("%04X\n", utf8::unicode_to_native($i));
19 }
20 return $return;
0f1b7392
RGS
21END
22}
23
d658a8a8 24sub Other::IsClass {
df6c5b1f
KW
25 my $return = "";
26 for my $i (0x40 .. 0x5F) {
27 $return .= sprintf("%04X\n", utf8::unicode_to_native($i));
28 }
29 return $return;
0f1b7392
RGS
30}
31
32sub A::B::Intersection {
33 <<END;
d658a8a8
DM
34+main::IsMyUniClass
35&Other::IsClass
0f1b7392
RGS
36END
37}
38
cd1c2c69
T
39sub test_regexp ($$) {
40 # test that given string consists of N-1 chars matching $qr1, and 1
41 # char matching $qr2
42 my ($str, $blk) = @_;
43
44 # constructing these objects here makes the last test loop go much faster
45 my $qr1 = qr/(\p{$blk}+)/;
46 if ($str =~ $qr1) {
47 is($1, substr($str, 0, -1)); # all except last char
48 }
49 else {
50 fail('first N-1 chars did not match');
51 }
52
53 my $qr2 = qr/(\P{$blk}+)/;
54 if ($str =~ $qr2) {
55 is($1, substr($str, -1)); # only last char
56 }
57 else {
58 fail('last char did not match');
59 }
60}
61
62use strict;
0f1b7392 63
0f1b7392
RGS
64# make sure it finds built-in class
65is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
12ac2576 66is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
0f1b7392
RGS
67
68# make sure it finds user-defined class
d658a8a8 69is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO');
0f1b7392
RGS
70
71# make sure it finds class in other package
d658a8a8 72is(($str =~ /(\p{Other::IsClass}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
0f1b7392
RGS
73
74# make sure it finds class in other OTHER package
75is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO');
12ac2576 76
484741e1
KW
77# lib/unicore/lib/Bc/AL.pl. U+070E is unassigned, currently, but still has
78# bidi class AL. The first one in the sequence that doesn't is 0711, which is
79# BC=NSM.
80$str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}\x{0712}";
81is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{0711}");
82is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{0711}");
83is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{0711}");
84is(($str =~ /(\P{bc=AL}+)/)[0], "\x{0711}");
12ac2576
JP
85
86# make sure InGreek works
87$str = "[\x{038B}\x{038C}\x{038D}]";
88
89is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
cd1c2c69 90
4531f512
KW
91{ # [perl #133860], compilation before data for it is available
92 package Foo;
93
94 sub make {
95 my @lines;
96 while( my($c) = splice(@_,0,1) ) {
97 push @lines, sprintf("%04X", $c);
98 }
99 return join "\n", @lines;
100 }
101
102 my @characters = ( ord("a") );
103 sub IsProperty { make(@characters); };
104
105 main::like('a', qr/\p{IsProperty}/, "foo");
106}
107
99870f4d 108# The other tests that are based on looking at the generated files are now
3df51b85 109# in t/re/uniprops.t