projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Document SvGAMAGIC(), and its significance w.r.t. the side effects of
[p5sagit/p5-mst-13.2.git] / t / uni / overload.t
CommitLineData
92331800 1#!perl -w
2
3BEGIN {
4 if ($ENV{'PERL_CORE'}){
5 chdir 't';
6 @INC = '../lib';
7 }
8}
9
c9cb0f41 10use Test::More tests => 116;
92331800 11
ec9af7d4 12package UTF8Toggle;
92331800 13use strict;
14
15use overload '""' => 'stringify';
16
17sub new {
18 my $class = shift;
676f44e7 19 my $value = shift;
20 my $state = shift||0;
21 return bless [$value, $state], $class;
92331800 22}
23
24sub stringify {
25 my $self = shift;
26 $self->[1] = ! $self->[1];
27 if ($self->[1]) {
28 utf8::downgrade($self->[0]);
29 } else {
30 utf8::upgrade($self->[0]);
31 }
32 $self->[0];
33}
34
35package main;
36
37# Bug 34297
38foreach my $t ("ASCII", "B\366se") {
39 my $length = length $t;
40
ec9af7d4 41 my $u = UTF8Toggle->new($t);
92331800 42 is (length $u, $length, "length of '$t'");
43 is (length $u, $length, "length of '$t'");
44 is (length $u, $length, "length of '$t'");
45 is (length $u, $length, "length of '$t'");
46}
ec9af7d4 47
6e08b83d 48my $u = UTF8Toggle->new("\311");
49my $lc = lc $u;
50is (length $lc, 1);
51is ($lc, "\311", "E accute -> e accute");
52$lc = lc $u;
53is (length $lc, 1);
54is ($lc, "\351", "E accute -> e accute");
55$lc = lc $u;
56is (length $lc, 1);
57is ($lc, "\311", "E accute -> e accute");
58
59$u = UTF8Toggle->new("\351");
60my $uc = uc $u;
61is (length $uc, 1);
62is ($uc, "\351", "e accute -> E accute");
63$uc = uc $u;
64is (length $uc, 1);
65is ($uc, "\311", "e accute -> E accute");
66$uc = uc $u;
67is (length $uc, 1);
68is ($uc, "\351", "e accute -> E accute");
69
70$u = UTF8Toggle->new("\311");
71$lc = lcfirst $u;
72is (length $lc, 1);
73is ($lc, "\311", "E accute -> e accute");
74$lc = lcfirst $u;
75is (length $lc, 1);
76is ($lc, "\351", "E accute -> e accute");
77$lc = lcfirst $u;
78is (length $lc, 1);
79is ($lc, "\311", "E accute -> e accute");
80
81$u = UTF8Toggle->new("\351");
82$uc = ucfirst $u;
83is (length $uc, 1);
84is ($uc, "\351", "e accute -> E accute");
85$uc = ucfirst $u;
86is (length $uc, 1);
87is ($uc, "\311", "e accute -> E accute");
88$uc = ucfirst $u;
89is (length $uc, 1);
90is ($uc, "\351", "e accute -> E accute");
91
ec9af7d4 92my $have_setlocale = 0;
93eval {
94 require POSIX;
95 import POSIX ':locale_h';
96 $have_setlocale++;
97};
98
99SKIP: {
100 if (!$have_setlocale) {
6e08b83d 101 skip "No setlocale", 24;
ec9af7d4 102 } elsif (!setlocale(&POSIX::LC_ALL, "en_GB.ISO8859-1")) {
6e08b83d 103 skip "Could not setlocale to en_GB.ISO8859-1", 24;
ec9af7d4 104 } else {
105 use locale;
106 my $u = UTF8Toggle->new("\311");
107 my $lc = lc $u;
108 is (length $lc, 1);
109 is ($lc, "\351", "E accute -> e accute");
110 $lc = lc $u;
111 is (length $lc, 1);
112 is ($lc, "\351", "E accute -> e accute");
6e08b83d 113 $lc = lc $u;
114 is (length $lc, 1);
115 is ($lc, "\351", "E accute -> e accute");
67306194 116
117 $u = UTF8Toggle->new("\351");
118 my $uc = uc $u;
119 is (length $uc, 1);
120 is ($uc, "\311", "e accute -> E accute");
121 $uc = uc $u;
122 is (length $uc, 1);
123 is ($uc, "\311", "e accute -> E accute");
6e08b83d 124 $uc = uc $u;
125 is (length $uc, 1);
126 is ($uc, "\311", "e accute -> E accute");
d54190f6 127
128 $u = UTF8Toggle->new("\311");
129 $lc = lcfirst $u;
130 is (length $lc, 1);
131 is ($lc, "\351", "E accute -> e accute");
132 $lc = lcfirst $u;
133 is (length $lc, 1);
134 is ($lc, "\351", "E accute -> e accute");
6e08b83d 135 $lc = lcfirst $u;
136 is (length $lc, 1);
137 is ($lc, "\351", "E accute -> e accute");
d54190f6 138
139 $u = UTF8Toggle->new("\351");
140 $uc = ucfirst $u;
141 is (length $uc, 1);
142 is ($uc, "\311", "e accute -> E accute");
143 $uc = ucfirst $u;
144 is (length $uc, 1);
145 is ($uc, "\311", "e accute -> E accute");
6e08b83d 146 $uc = ucfirst $u;
147 is (length $uc, 1);
148 is ($uc, "\311", "e accute -> E accute");
ec9af7d4 149 }
150}
676f44e7 151
152my $tmpfile = 'overload.tmp';
153
c9cb0f41 154foreach my $operator ('print', 'syswrite', 'syswrite len', 'syswrite off',
155 'syswrite len off') {
676f44e7 156 foreach my $layer ('', ':utf8') {
157 open my $fh, "+>$layer", $tmpfile or die $!;
c9cb0f41 158 my $pad = $operator =~ /\boff\b/ ? "\243" : "";
159 my $trail = $operator =~ /\blen\b/ ? "!" : "";
160 my $u = UTF8Toggle->new("$pad\311\n$trail");
161 my $l = UTF8Toggle->new("$pad\351\n$trail", 1);
162 if ($operator eq 'print') {
163 print $fh $u;
164 print $fh $u;
165 print $fh $u;
166 print $fh $l;
167 print $fh $l;
168 print $fh $l;
169 } elsif ($operator eq 'syswrite') {
170 syswrite $fh, $u;
171 syswrite $fh, $u;
172 syswrite $fh, $u;
173 syswrite $fh, $l;
174 syswrite $fh, $l;
175 syswrite $fh, $l;
176 } elsif ($operator eq 'syswrite len') {
177 syswrite $fh, $u, 2;
178 syswrite $fh, $u, 2;
179 syswrite $fh, $u, 2;
180 syswrite $fh, $l, 2;
181 syswrite $fh, $l, 2;
182 syswrite $fh, $l, 2;
183 } elsif ($operator eq 'syswrite off'
184 || $operator eq 'syswrite len off') {
185 syswrite $fh, $u, 2, 1;
186 syswrite $fh, $u, 2, 1;
187 syswrite $fh, $u, 2, 1;
188 syswrite $fh, $l, 2, 1;
189 syswrite $fh, $l, 2, 1;
190 syswrite $fh, $l, 2, 1;
191 } else {
192 die $operator;
193 }
676f44e7 194
195 seek $fh, 0, 0 or die $!;
196 my $line;
197 chomp ($line = <$fh>);
198 is ($line, "\311", "$operator $layer");
199 chomp ($line = <$fh>);
200 is ($line, "\311", "$operator $layer");
201 chomp ($line = <$fh>);
202 is ($line, "\311", "$operator $layer");
203 chomp ($line = <$fh>);
204 is ($line, "\351", "$operator $layer");
205 chomp ($line = <$fh>);
206 is ($line, "\351", "$operator $layer");
207 chomp ($line = <$fh>);
208 is ($line, "\351", "$operator $layer");
209
210 close $fh or die $!;
211 unlink $tmpfile or die $!;
212 }
213}
214
215
216END {
217 1 while -f $tmpfile and unlink $tmpfile || die "unlink '$tmpfile': $!";
218}
Unnamed repository; edit this file to name it for gitweb.