t/uni/tie.t

   1 #!perl -w
   2
   3 BEGIN {
   4     if ($ENV{'PERL_CORE'}){
   5         chdir 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 use Test::More tests => 9;
  11 use strict;
  12
  13 {
  14     package UTF8Toggle;
  15
  16     sub TIESCALAR {
  17         my $class = shift;
  18         my $value = shift;
  19         my $state = shift||0;
  20         return bless [$value, $state], $class;
  21     }
  22
  23     sub FETCH {
  24         my $self = shift;
  25         $self->[1] = ! $self->[1];
  26         if ($self->[1]) {
  27             utf8::downgrade($self->[0]);
  28         } else {
  29             utf8::upgrade($self->[0]);
  30         }
  31         $self->[0];
  32     }
  33 }
  34
  35 foreach my $t ("ASCII", "B\366se") {
  36     my $length = length $t;
  37
  38     my $u;
  39     tie $u, 'UTF8Toggle',  $t;
  40     is (length $u, $length, "length of '$t'");
  41     is (length $u, $length, "length of '$t'");
  42     is (length $u, $length, "length of '$t'");
  43     is (length $u, $length, "length of '$t'");
  44 }
  45
  46 {
  47     local $TODO = "Need more tests!";
  48     fail();
  49 }