This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
uc plus an 8 bit locale could get confused by UTF-8 values returned by
[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
67306194 10use Test::More tests => 16;
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
NC
45
46my $have_setlocale = 0;
47eval {
48 require POSIX;
49 import POSIX ':locale_h';
50 $have_setlocale++;
51};
52
53SKIP: {
54 if (!$have_setlocale) {
55 skip "No setlocale", 4;
56 } elsif (!setlocale(&POSIX::LC_ALL, "en_GB.ISO8859-1")) {
57 skip "Could not setlocale to en_GB.ISO8859-1", 4;
58 } else {
59 use locale;
60 my $u = UTF8Toggle->new("\311");
61 my $lc = lc $u;
62 is (length $lc, 1);
63 is ($lc, "\351", "E accute -> e accute");
64 $lc = lc $u;
65 is (length $lc, 1);
66 is ($lc, "\351", "E accute -> e accute");
67306194
NC
67
68 $u = UTF8Toggle->new("\351");
69 my $uc = uc $u;
70 is (length $uc, 1);
71 is ($uc, "\311", "e accute -> E accute");
72 $uc = uc $u;
73 is (length $uc, 1);
74 is ($uc, "\311", "e accute -> E accute");
ec9af7d4
NC
75 }
76}