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