t/uni/tie.t

   1 #!perl -w
   2
   3 BEGIN {
   4     require './test.pl';
   5 }
   6
   7 plan (tests => 10);
   8 use strict;
   9
  10 {
  11     package UTF8Toggle;
  12
  13     sub TIESCALAR {
  14         my $class = shift;
  15         my $value = shift;
  16         my $state = shift||0;
  17         return bless [$value, $state], $class;
  18     }
  19
  20     sub FETCH {
  21         my $self = shift;
  22         $self->[1] = ! $self->[1];
  23         if ($self->[1]) {
  24             utf8::downgrade($self->[0]);
  25         } else {
  26             utf8::upgrade($self->[0]);
  27         }
  28         $self->[0];
  29     }
  30 }
  31
  32 foreach my $t ("ASCII", "B\366se") {
  33     my $length = length $t;
  34
  35     my $u;
  36     tie $u, 'UTF8Toggle',  $t;
  37     is (length $u, $length, "length of '$t'");
  38     is (length $u, $length, "length of '$t'");
  39     is (length $u, $length, "length of '$t'");
  40     is (length $u, $length, "length of '$t'");
  41 }
  42
  43 {
  44     use utf8;
  45     use open qw( :utf8 :std );
  46     package Tìè::UTF8 {
  47         sub TIESCALAR {
  48             return bless {}, shift;
  49         }
  50     }
  51
  52     my $t;
  53     tie $t, 'Tìè::UTF8';
  54     is ref(tied($t)), 'Tìè::UTF8', "Tie'ing to a UTF8 package works.";
  55 }
  56 {
  57     local $::TODO = "Need more tests!";
  58     fail();
  59 }