cpan/Unicode-Normalize/t/tie.t

   1
   2 BEGIN {
   3     unless ('A' eq pack('U', 0x41)) {
   4         print "1..0 # Unicode::Normalize cannot pack a Unicode code point\n";
   5         exit 0;
   6     }
   7     unless (0x41 == unpack('U', 'A')) {
   8         print "1..0 # Unicode::Normalize cannot get a Unicode code point\n";
   9         exit 0;
  10     }
  11 }
  12
  13 BEGIN {
  14     if ($ENV{PERL_CORE}) {
  15         chdir('t') if -d 't';
  16         @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
  17     }
  18 }
  19
  20 #########################
  21
  22 BEGIN {
  23     use Unicode::Normalize qw(:all);
  24
  25     unless (exists &Unicode::Normalize::bootstrap or 5.008 <= $]) {
  26         print "1..0 # skipped: XSUB, or Perl 5.8.0 or later".
  27                 " needed for this test\n";
  28         print $@;
  29         exit;
  30     }
  31 }
  32
  33 use strict;
  34 use warnings;
  35 BEGIN { $| = 1; print "1..17\n"; }
  36 my $count = 0;
  37 sub ok ($;$) {
  38     my $p = my $r = shift;
  39     if (@_) {
  40         my $x = shift;
  41         $p = !defined $x ? !defined $r : !defined $r ? 0 : $r eq $x;
  42     }
  43     print $p ? "ok" : "not ok", ' ', ++$count, "\n";
  44 }
  45
  46 ok(1);
  47
  48 package tiescalar;
  49 sub TIESCALAR {
  50     my ($class, $instance) = @_;
  51     return bless \$instance => $class;
  52 }
  53 sub FETCH   { return ${$_[0]}++ }
  54 sub STORE   { return ${$_[0]} = $_[1] }
  55 sub DESTROY { undef ${$_[0]} }
  56
  57 #########################
  58
  59 package main;
  60
  61 tie my $tie1, 'tiescalar', "123";
  62 ok(NFD($tie1),  123);
  63 ok(NFC($tie1),  124);
  64 ok(NFKD($tie1), 125);
  65 ok(NFKC($tie1), 126);
  66 ok(FCD($tie1),  127);
  67 ok(FCC($tie1),  128);
  68
  69 tie my $tie2, 'tiescalar', "256";
  70 ok(normalize('NFD',  $tie2), 256);
  71 ok(normalize('NFC',  $tie2), 257);
  72 ok(normalize('NFKD', $tie2), 258);
  73 ok(normalize('NFKC', $tie2), 259);
  74 ok(normalize('FCD',  $tie2), 260);
  75 ok(normalize('FCC',  $tie2), 261);
  76
  77 tie my $tie3, 'tiescalar', "315";
  78 ok(decompose($tie3),         315);
  79 ok(reorder($tie3),           316);
  80 ok(compose($tie3),           317);
  81 ok(composeContiguous($tie3), 318);
  82