Commit | Line | Data |
---|---|---|
d0644529 NC |
1 | #!perl -w |
2 | ||
3 | BEGIN { | |
e4206093 | 4 | require './test.pl'; |
d0644529 NC |
5 | } |
6 | ||
4886938f | 7 | plan (tests => 10); |
d0644529 NC |
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 | { | |
4886938f BF |
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 | { | |
e4206093 | 57 | local $::TODO = "Need more tests!"; |
d0644529 NC |
58 | fail(); |
59 | } |