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 MyUniClass {
  10   <<END;
  11 0030    004F
  12 END
  13 }
  14
  15 sub Other::Class {
  16   <<END;
  17 0040    005F
  18 END
  19 }
  20
  21 sub A::B::Intersection {
  22   <<END;
  23 +main::MyUniClass
  24 &Other::Class
  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;
  54
  55 if (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
  62 is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
  63 is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
  64
  65 # make sure it finds user-defined class
  66 is(($str =~ /(\p{MyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO');
  67
  68 # make sure it finds class in other package
  69 is(($str =~ /(\p{Other::Class}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
  70
  71 # make sure it finds class in other OTHER package
  72 is(($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}";
  76 is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{070F}");
  77 is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{070F}");
  78 is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{070F}");
  79 is(($str =~ /(\P{bc=AL}+)/)[0], "\x{070F}");
  80
  81 # make sure InGreek works
  82 $str = "[\x{038B}\x{038C}\x{038D}]";
  83
  84 is(($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