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