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 }