Commit | Line | Data |
92331800 |
1 | #!perl -w |
2 | |
3 | BEGIN { |
4 | if ($ENV{'PERL_CORE'}){ |
5 | chdir 't'; |
6 | @INC = '../lib'; |
7 | } |
8 | } |
9 | |
6e08b83d |
10 | use Test::More tests => 56; |
92331800 |
11 | |
ec9af7d4 |
12 | package UTF8Toggle; |
92331800 |
13 | use strict; |
14 | |
15 | use overload '""' => 'stringify'; |
16 | |
17 | sub new { |
18 | my $class = shift; |
19 | return bless [shift, 0], $class; |
20 | } |
21 | |
22 | sub stringify { |
23 | my $self = shift; |
24 | $self->[1] = ! $self->[1]; |
25 | if ($self->[1]) { |
26 | utf8::downgrade($self->[0]); |
27 | } else { |
28 | utf8::upgrade($self->[0]); |
29 | } |
30 | $self->[0]; |
31 | } |
32 | |
33 | package main; |
34 | |
35 | # Bug 34297 |
36 | foreach my $t ("ASCII", "B\366se") { |
37 | my $length = length $t; |
38 | |
ec9af7d4 |
39 | my $u = UTF8Toggle->new($t); |
92331800 |
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 | } |
ec9af7d4 |
45 | |
6e08b83d |
46 | my $u = UTF8Toggle->new("\311"); |
47 | my $lc = lc $u; |
48 | is (length $lc, 1); |
49 | is ($lc, "\311", "E accute -> e accute"); |
50 | $lc = lc $u; |
51 | is (length $lc, 1); |
52 | is ($lc, "\351", "E accute -> e accute"); |
53 | $lc = lc $u; |
54 | is (length $lc, 1); |
55 | is ($lc, "\311", "E accute -> e accute"); |
56 | |
57 | $u = UTF8Toggle->new("\351"); |
58 | my $uc = uc $u; |
59 | is (length $uc, 1); |
60 | is ($uc, "\351", "e accute -> E accute"); |
61 | $uc = uc $u; |
62 | is (length $uc, 1); |
63 | is ($uc, "\311", "e accute -> E accute"); |
64 | $uc = uc $u; |
65 | is (length $uc, 1); |
66 | is ($uc, "\351", "e accute -> E accute"); |
67 | |
68 | $u = UTF8Toggle->new("\311"); |
69 | $lc = lcfirst $u; |
70 | is (length $lc, 1); |
71 | is ($lc, "\311", "E accute -> e accute"); |
72 | $lc = lcfirst $u; |
73 | is (length $lc, 1); |
74 | is ($lc, "\351", "E accute -> e accute"); |
75 | $lc = lcfirst $u; |
76 | is (length $lc, 1); |
77 | is ($lc, "\311", "E accute -> e accute"); |
78 | |
79 | $u = UTF8Toggle->new("\351"); |
80 | $uc = ucfirst $u; |
81 | is (length $uc, 1); |
82 | is ($uc, "\351", "e accute -> E accute"); |
83 | $uc = ucfirst $u; |
84 | is (length $uc, 1); |
85 | is ($uc, "\311", "e accute -> E accute"); |
86 | $uc = ucfirst $u; |
87 | is (length $uc, 1); |
88 | is ($uc, "\351", "e accute -> E accute"); |
89 | |
ec9af7d4 |
90 | my $have_setlocale = 0; |
91 | eval { |
92 | require POSIX; |
93 | import POSIX ':locale_h'; |
94 | $have_setlocale++; |
95 | }; |
96 | |
97 | SKIP: { |
98 | if (!$have_setlocale) { |
6e08b83d |
99 | skip "No setlocale", 24; |
ec9af7d4 |
100 | } elsif (!setlocale(&POSIX::LC_ALL, "en_GB.ISO8859-1")) { |
6e08b83d |
101 | skip "Could not setlocale to en_GB.ISO8859-1", 24; |
ec9af7d4 |
102 | } else { |
103 | use locale; |
104 | my $u = UTF8Toggle->new("\311"); |
105 | my $lc = lc $u; |
106 | is (length $lc, 1); |
107 | is ($lc, "\351", "E accute -> e accute"); |
108 | $lc = lc $u; |
109 | is (length $lc, 1); |
110 | is ($lc, "\351", "E accute -> e accute"); |
6e08b83d |
111 | $lc = lc $u; |
112 | is (length $lc, 1); |
113 | is ($lc, "\351", "E accute -> e accute"); |
67306194 |
114 | |
115 | $u = UTF8Toggle->new("\351"); |
116 | my $uc = uc $u; |
117 | is (length $uc, 1); |
118 | is ($uc, "\311", "e accute -> E accute"); |
119 | $uc = uc $u; |
120 | is (length $uc, 1); |
121 | is ($uc, "\311", "e accute -> E accute"); |
6e08b83d |
122 | $uc = uc $u; |
123 | is (length $uc, 1); |
124 | is ($uc, "\311", "e accute -> E accute"); |
d54190f6 |
125 | |
126 | $u = UTF8Toggle->new("\311"); |
127 | $lc = lcfirst $u; |
128 | is (length $lc, 1); |
129 | is ($lc, "\351", "E accute -> e accute"); |
130 | $lc = lcfirst $u; |
131 | is (length $lc, 1); |
132 | is ($lc, "\351", "E accute -> e accute"); |
6e08b83d |
133 | $lc = lcfirst $u; |
134 | is (length $lc, 1); |
135 | is ($lc, "\351", "E accute -> e accute"); |
d54190f6 |
136 | |
137 | $u = UTF8Toggle->new("\351"); |
138 | $uc = ucfirst $u; |
139 | is (length $uc, 1); |
140 | is ($uc, "\311", "e accute -> E accute"); |
141 | $uc = ucfirst $u; |
142 | is (length $uc, 1); |
143 | is ($uc, "\311", "e accute -> E accute"); |
6e08b83d |
144 | $uc = ucfirst $u; |
145 | is (length $uc, 1); |
146 | is ($uc, "\311", "e accute -> E accute"); |
ec9af7d4 |
147 | } |
148 | } |