t/uni/tie.t

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