Commit | Line | Data |
d0644529 |
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 | } |