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 => 11;
   8
   9
  10 my $str = join "", map { chr utf8::unicode_to_native($_) } 0x20 .. 0x6F;
  11
  12 is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO',
  13                                 'user-defined class compiled before defined');
  14
  15 sub IsMyUniClass {
  16   <<END;
  17 0030    004F
  18 END
  19 }
  20
  21 sub Other::IsClass {
  22   <<END;
  23 0040    005F
  24 END
  25 }
  26
  27 sub A::B::Intersection {
  28   <<END;
  29 +main::IsMyUniClass
  30 &Other::IsClass
  31 END
  32 }
  33
  34 sub test_regexp ($$) {
  35   # test that given string consists of N-1 chars matching $qr1, and 1
  36   # char matching $qr2
  37   my ($str, $blk) = @_;
  38
  39   # constructing these objects here makes the last test loop go much faster
  40   my $qr1 = qr/(\p{$blk}+)/;
  41   if ($str =~ $qr1) {
  42     is($1, substr($str, 0, -1));                # all except last char
  43   }
  44   else {
  45     fail('first N-1 chars did not match');
  46   }
  47
  48   my $qr2 = qr/(\P{$blk}+)/;
  49   if ($str =~ $qr2) {
  50     is($1, substr($str, -1));                   # only last char
  51   }
  52   else {
  53     fail('last char did not match');
  54   }
  55 }
  56
  57 use strict;
  58
  59 # make sure it finds built-in class
  60 is(($str =~ /(\p{Letter}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
  61 is(($str =~ /(\p{l}+)/)[0], 'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
  62
  63 # make sure it finds user-defined class
  64 is(($str =~ /(\p{IsMyUniClass}+)/)[0], '0123456789:;<=>?@ABCDEFGHIJKLMNO');
  65
  66 # make sure it finds class in other package
  67 is(($str =~ /(\p{Other::IsClass}+)/)[0], '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
  68
  69 # make sure it finds class in other OTHER package
  70 is(($str =~ /(\p{A::B::Intersection}+)/)[0], '@ABCDEFGHIJKLMNO');
  71
  72 # lib/unicore/lib/Bc/AL.pl.  U+070E is unassigned, currently, but still has
  73 # bidi class AL.  The first one in the sequence that doesn't is 0711, which is
  74 # BC=NSM.
  75 $str = "\x{070D}\x{070E}\x{070F}\x{0710}\x{0711}\x{0712}";
  76 is(($str =~ /(\P{BidiClass: ArabicLetter}+)/)[0], "\x{0711}");
  77 is(($str =~ /(\P{BidiClass: AL}+)/)[0], "\x{0711}");
  78 is(($str =~ /(\P{BC :ArabicLetter}+)/)[0], "\x{0711}");
  79 is(($str =~ /(\P{bc=AL}+)/)[0], "\x{0711}");
  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