This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
95c916ae0d6ac6a8e24d808b954384965465f0a7
[perl5.git] / t / uni / overload.t
1 #!perl -w
2
3 BEGIN {
4     if ($ENV{'PERL_CORE'}){
5         chdir 't';
6         @INC = '../lib';
7     }
8 }
9
10 use Test::More tests => 56;
11
12 package UTF8Toggle;
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
39     my $u = UTF8Toggle->new($t);
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 }
45
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
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) {
99         skip "No setlocale", 24;
100     } elsif (!setlocale(&POSIX::LC_ALL, "en_GB.ISO8859-1")) {
101         skip "Could not setlocale to en_GB.ISO8859-1", 24;
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");
111         $lc = lc $u;
112         is (length $lc, 1);
113         is ($lc, "\351", "E accute -> e accute");
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");
122         $uc = uc $u;
123         is (length $uc, 1);
124         is ($uc, "\311", "e accute -> E accute");
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");
133         $lc = lcfirst $u;
134         is (length $lc, 1);
135         is ($lc, "\351", "E accute -> e accute");
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");
144         $uc = ucfirst $u;
145         is (length $uc, 1);
146         is ($uc, "\311", "e accute -> E accute");
147     }
148 }