This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
restrict \p{IsUserDefined} to In\w+ and In\w+
[perl5.git] / t / uni / class.t
1 BEGIN {
2     chdir 't' if -d 't';
3     @INC = qw(../lib .);
4     require "test.pl";
5 }
6
7 plan tests => 10;
8
9 sub IsMyUniClass {
10   <<END;
11 0030    004F
12 END
13 }
14
15 sub Other::IsClass {
16   <<END;
17 0040    005F
18 END
19 }
20
21 sub A::B::Intersection {
22   <<END;
23 +main::IsMyUniClass
24 &Other::IsClass
25 END
26 }
27
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;
52
53 my $str = join "", map latin1_to_native(chr($_)), 0x20 .. 0x6F;
54
55 # make sure it finds built-in class
56 is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
57 is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
58
59 # make sure it finds user-defined class
60 is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO');
61
62 # make sure it finds class in other package
63 is(($str =~ /(\p{Other::IsClass}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
64
65 # make sure it finds class in other OTHER package
66 is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO');
67
68 # lib/unicore/lib/Bc/AL.pl.  U+070E is unassigned, currently, but still has
69 # bidi class AL.  The first one in the sequence that doesn't is 0711, which is
70 # BC=NSM.
71 $str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}\x{0712}";
72 is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{0711}");
73 is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{0711}");
74 is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{0711}");
75 is(($str =~ /(\P{bc=AL}+)/)[0], "\x{0711}");
76
77 # make sure InGreek works
78 $str = "[\x{038B}\x{038C}\x{038D}]";
79
80 is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}");
81
82 # The other tests that are based on looking at the generated files are now
83 # in t/re/uniprops.t