1BEGIN { 2 chdir 't' if -d 't'; 3 @INC = qw(../lib .); 4 require "test.pl"; 5} 6 7plan tests => 10; 8 9sub MyUniClass { 10 <<END; 110030 004F 12END 13} 14 15sub Other::Class { 16 <<END; 170040 005F 18END 19} 20 21sub A::B::Intersection { 22 <<END; 23+main::MyUniClass 24&Other::Class 25END 26} 27 28sub 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 51use strict; 52 53my $str; 54 55if (ord('A') == 193) { 56 $str = join "", map chr($_), 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, 0xF0 .. 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, 0x7C, 0xC1 .. 0xC9, 0xD1 .. 0xD9, 0xE2 .. 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, 0x79, 0x81 .. 0x89, 0x91 .. 0x96; # IBM-1047 57} else { 58 $str = join "", map chr($_), 0x20 .. 0x6F; 59} 60 61# make sure it finds built-in class 62is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); 63is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'); 64 65# make sure it finds user-defined class 66is(($str =~ /(\p{MyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO'); 67 68# make sure it finds class in other package 69is(($str =~ /(\p{Other::Class}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); 70 71# make sure it finds class in other OTHER package 72is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO'); 73 74# lib/unicore/Bc/AL.pl 75$str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}"; 76is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{070F}"); 77is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{070F}"); 78is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{070F}"); 79is(($str =~ /(\P{bc=AL}+)/)[0], "\x{070F}"); 80 81# make sure InGreek works 82$str = "[\x{038B}\x{038C}\x{038D}]"; 83 84is(($str =~ /(\p{InGreek}+)/)[0], "\x{038B}\x{038C}\x{038D}"); 85 86# The other tests that are based on looking at the generated files are now 87# in t/re/uniprops.t 88