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 => 16;
  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 $have_setlocale = 0;
  47 eval {
  48     require POSIX;
  49     import POSIX ':locale_h';
  50     $have_setlocale++;
  51 };
  52
  53 SKIP: {
  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");
  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");
  75     }
  76 }