14 use overload '""' => 'stringify', fallback => 1;
20 return bless [$value, $state], $class;
25 $self->[1] = ! $self->[1];
27 utf8::downgrade($self->[0]);
29 utf8::upgrade($self->[0]);
36 # These tests are based on characters 128-255 not having latin1, and hence
38 # no feature "unicode_strings";
41 foreach my $t ("ASCII", "B\366se") {
42 my $length = length $t;
44 my $u = UTF8Toggle->new($t);
45 is (length $u, $length, "length of '$t'");
46 is (length $u, $length, "length of '$t'");
47 is (length $u, $length, "length of '$t'");
48 is (length $u, $length, "length of '$t'");
51 my $u = UTF8Toggle->new("\311");
54 is ($lc, "\311", "E acute -> e acute");
57 is ($lc, "\351", "E acute -> e acute");
60 is ($lc, "\311", "E acute -> e acute");
62 $u = UTF8Toggle->new("\351");
65 is ($uc, "\351", "e acute -> E acute");
68 is ($uc, "\311", "e acute -> E acute");
71 is ($uc, "\351", "e acute -> E acute");
73 $u = UTF8Toggle->new("\311");
76 is ($lc, "\311", "E acute -> e acute");
79 is ($lc, "\351", "E acute -> e acute");
82 is ($lc, "\311", "E acute -> e acute");
84 $u = UTF8Toggle->new("\351");
87 is ($uc, "\351", "e acute -> E acute");
90 is ($uc, "\311", "e acute -> E acute");
93 is ($uc, "\351", "e acute -> E acute");
95 my $have_setlocale = 0;
98 import POSIX ':locale_h';
103 if (!$have_setlocale) {
104 skip "No setlocale", 24;
105 } elsif (!setlocale(&POSIX::LC_ALL, "en_GB.ISO8859-1")) {
106 skip "Could not setlocale to en_GB.ISO8859-1", 24;
107 } elsif ($^O eq 'dec_osf' || $^O eq 'VMS') {
108 skip "$^O has broken en_GB.ISO8859-1 locale", 24;
111 my $u = UTF8Toggle->new("\311");
114 is ($lc, "\351", "E acute -> e acute");
117 is ($lc, "\351", "E acute -> e acute");
120 is ($lc, "\351", "E acute -> e acute");
122 $u = UTF8Toggle->new("\351");
125 is ($uc, "\311", "e acute -> E acute");
128 is ($uc, "\311", "e acute -> E acute");
131 is ($uc, "\311", "e acute -> E acute");
133 $u = UTF8Toggle->new("\311");
136 is ($lc, "\351", "E acute -> e acute");
139 is ($lc, "\351", "E acute -> e acute");
142 is ($lc, "\351", "E acute -> e acute");
144 $u = UTF8Toggle->new("\351");
147 is ($uc, "\311", "e acute -> E acute");
150 is ($uc, "\311", "e acute -> E acute");
153 is ($uc, "\311", "e acute -> E acute");
157 my $tmpfile = tempfile();
159 foreach my $operator ('print', 'syswrite', 'syswrite len', 'syswrite off',
160 'syswrite len off') {
161 foreach my $layer ('', ':utf8') {
162 open my $fh, "+>$layer", $tmpfile or die $!;
163 my $pad = $operator =~ /\boff\b/ ? "\243" : "";
164 my $trail = $operator =~ /\blen\b/ ? "!" : "";
165 my $u = UTF8Toggle->new("$pad\311\n$trail");
166 my $l = UTF8Toggle->new("$pad\351\n$trail", 1);
167 if ($operator eq 'print') {
175 } elsif ($operator eq 'syswrite') {
182 } elsif ($operator eq 'syswrite len') {
189 } elsif ($operator eq 'syswrite off'
190 || $operator eq 'syswrite len off') {
191 syswrite $fh, $u, 2, 1;
192 syswrite $fh, $u, 2, 1;
193 syswrite $fh, $u, 2, 1;
194 syswrite $fh, $l, 2, 1;
195 syswrite $fh, $l, 2, 1;
196 syswrite $fh, $l, 2, 1;
201 seek $fh, 0, 0 or die $!;
203 chomp ($line = <$fh>);
204 is ($line, "\311", "$operator $layer");
205 chomp ($line = <$fh>);
206 is ($line, "\311", "$operator $layer");
207 chomp ($line = <$fh>);
208 is ($line, "\311", "$operator $layer");
209 chomp ($line = <$fh>);
210 is ($line, "\351", "$operator $layer");
211 chomp ($line = <$fh>);
212 is ($line, "\351", "$operator $layer");
213 chomp ($line = <$fh>);
214 is ($line, "\351", "$operator $layer");
220 my $little = "\243\243";
221 my $big = " \243 $little ! $little ! $little \243 ";
222 my $right = rindex $big, $little;
223 my $right1 = rindex $big, $little, 11;
224 my $left = index $big, $little;
225 my $left1 = index $big, $little, 4;
227 cmp_ok ($right, ">", $right1, "Sanity check our rindex tests");
228 cmp_ok ($left, "<", $left1, "Sanity check our index tests");
230 foreach my $b ($big, UTF8Toggle->new($big)) {
231 foreach my $l ($little, UTF8Toggle->new($little),
232 UTF8Toggle->new($little, 1)) {
233 is (rindex ($b, $l), $right, "rindex");
234 is (rindex ($b, $l), $right, "rindex");
235 is (rindex ($b, $l), $right, "rindex");
237 is (rindex ($b, $l, 11), $right1, "rindex 11");
238 is (rindex ($b, $l, 11), $right1, "rindex 11");
239 is (rindex ($b, $l, 11), $right1, "rindex 11");
241 is (index ($b, $l), $left, "index");
242 is (index ($b, $l), $left, "index");
243 is (index ($b, $l), $left, "index");
245 is (index ($b, $l, 4), $left1, "index 4");
246 is (index ($b, $l, 4), $left1, "index 4");
247 is (index ($b, $l, 4), $left1, "index 4");
252 foreach my $pieces ($bits, UTF8Toggle->new($bits)) {
253 like ($bits ^ $pieces, qr/\A\0+\z/, "something xor itself is zeros");
254 like ($bits ^ $pieces, qr/\A\0+\z/, "something xor itself is zeros");
255 like ($bits ^ $pieces, qr/\A\0+\z/, "something xor itself is zeros");
257 like ($pieces ^ $bits, qr/\A\0+\z/, "something xor itself is zeros");
258 like ($pieces ^ $bits, qr/\A\0+\z/, "something xor itself is zeros");
259 like ($pieces ^ $bits, qr/\A\0+\z/, "something xor itself is zeros");
262 foreach my $value ("\243", UTF8Toggle->new("\243")) {
263 is (pack ("A/A", $value), pack ("A/A", "\243"),
264 "pack copes with overloading");
265 is (pack ("A/A", $value), pack ("A/A", "\243"));
266 is (pack ("A/A", $value), pack ("A/A", "\243"));
269 foreach my $value ("\243", UTF8Toggle->new("\243")) {
271 $v = substr $value, 0, 1;
273 $v = substr $value, 0, 1;
275 $v = substr $value, 0, 1;
281 use overload '""' => sub { $_[0]->{data} }
285 my $text = bless { data => "\x{3075}" }, 'RT69422';
286 my $p = substr $text, 0, 1;