This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
There were more ways to break uc/lc/ucfirst/lcfirst even without
[perl5.git] / t / uni / overload.t
CommitLineData
92331800
NC
1#!perl -w
2
3BEGIN {
4 if ($ENV{'PERL_CORE'}){
5 chdir 't';
6 @INC = '../lib';
7 }
8}
9
6e08b83d 10use Test::More tests => 56;
92331800 11
ec9af7d4 12package UTF8Toggle;
92331800
NC
13use strict;
14
15use overload '""' => 'stringify';
16
17sub new {
18 my $class = shift;
19 return bless [shift, 0], $class;
20}
21
22sub 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
33package main;
34
35# Bug 34297
36foreach my $t ("ASCII", "B\366se") {
37 my $length = length $t;
38
ec9af7d4 39 my $u = UTF8Toggle->new($t);
92331800
NC
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
NC
46my $u = UTF8Toggle->new("\311");
47my $lc = lc $u;
48is (length $lc, 1);
49is ($lc, "\311", "E accute -> e accute");
50$lc = lc $u;
51is (length $lc, 1);
52is ($lc, "\351", "E accute -> e accute");
53$lc = lc $u;
54is (length $lc, 1);
55is ($lc, "\311", "E accute -> e accute");
56
57$u = UTF8Toggle->new("\351");
58my $uc = uc $u;
59is (length $uc, 1);
60is ($uc, "\351", "e accute -> E accute");
61$uc = uc $u;
62is (length $uc, 1);
63is ($uc, "\311", "e accute -> E accute");
64$uc = uc $u;
65is (length $uc, 1);
66is ($uc, "\351", "e accute -> E accute");
67
68$u = UTF8Toggle->new("\311");
69$lc = lcfirst $u;
70is (length $lc, 1);
71is ($lc, "\311", "E accute -> e accute");
72$lc = lcfirst $u;
73is (length $lc, 1);
74is ($lc, "\351", "E accute -> e accute");
75$lc = lcfirst $u;
76is (length $lc, 1);
77is ($lc, "\311", "E accute -> e accute");
78
79$u = UTF8Toggle->new("\351");
80$uc = ucfirst $u;
81is (length $uc, 1);
82is ($uc, "\351", "e accute -> E accute");
83$uc = ucfirst $u;
84is (length $uc, 1);
85is ($uc, "\311", "e accute -> E accute");
86$uc = ucfirst $u;
87is (length $uc, 1);
88is ($uc, "\351", "e accute -> E accute");
89
ec9af7d4
NC
90my $have_setlocale = 0;
91eval {
92 require POSIX;
93 import POSIX ':locale_h';
94 $have_setlocale++;
95};
96
97SKIP: {
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
NC
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
NC
111 $lc = lc $u;
112 is (length $lc, 1);
113 is ($lc, "\351", "E accute -> e accute");
67306194
NC
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
NC
122 $uc = uc $u;
123 is (length $uc, 1);
124 is ($uc, "\311", "e accute -> E accute");
d54190f6
NC
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
NC
133 $lc = lcfirst $u;
134 is (length $lc, 1);
135 is ($lc, "\351", "E accute -> e accute");
d54190f6
NC
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
NC
144 $uc = ucfirst $u;
145 is (length $uc, 1);
146 is ($uc, "\311", "e accute -> E accute");
ec9af7d4
NC
147 }
148}