1BEGIN { 2 chdir 't' if -d 't'; 3 @INC = qw(../lib .); 4 require "test.pl"; 5} 6 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'); 13 14sub IsMyUniClass { 15 <<END; 160030 004F 17END 18} 19 20sub Other::IsClass { 21 <<END; 220040 005F 23END 24} 25 26sub A::B::Intersection { 27 <<END; 28+main::IsMyUniClass 29&Other::IsClass 30END 31} 32 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; 57 58# make sure it finds built-in class 59is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); 60is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); 61 62# make sure it finds user-defined class 63is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO'); 64 65# make sure it finds class in other package 66is(($str =~ /(\p{Other::IsClass}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); 67 68# make sure it finds class in other OTHER package 69is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO'); 70 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}"); 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}"); 84 85# The other tests that are based on looking at the generated files are now 86# in t/re/uniprops.t 87