dist/Devel-PPPort/t/utf8.t

   1 ################################################################################
   2 #
   3 #            !!!!!   Do NOT edit this file directly!   !!!!!
   4 #
   5 #            Edit mktests.PL and/or parts/inc/utf8 instead.
   6 #
   7 #  This file was automatically generated from the definition files in the
   8 #  parts/inc/ subdirectory by mktests.PL. To learn more about how all this
   9 #  works, please read the F<HACKERS> file that came with this distribution.
  10 #
  11 ################################################################################
  12
  13 BEGIN {
  14   if ($ENV{'PERL_CORE'}) {
  15     chdir 't' if -d 't';
  16     @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext';
  17     require Config; import Config;
  18     use vars '%Config';
  19     if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
  20       print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
  21       exit 0;
  22     }
  23   }
  24   else {
  25     unshift @INC, 't';
  26   }
  27
  28   sub load {
  29     eval "use Test";
  30     require 'testutil.pl' if $@;
  31   }
  32
  33   if (55) {
  34     load();
  35     plan(tests => 55);
  36   }
  37 }
  38
  39 use Devel::PPPort;
  40 use strict;
  41 BEGIN { $^W = 1; }
  42
  43 package Devel::PPPort;
  44 use vars '@ISA';
  45 require DynaLoader;
  46 @ISA = qw(DynaLoader);
  47 bootstrap Devel::PPPort;
  48
  49 package main;
  50
  51 BEGIN { require warnings if "$]" gt '5.006' }
  52
  53 # skip tests on 5.6.0 and earlier
  54 if ("$]" le '5.006') {
  55     skip 'skip: broken utf8 support', 0 for 1..55;
  56     exit;
  57 }
  58
  59 ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
  60 ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
  61
  62 ok(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
  63 ok(&Devel::PPPort::isUTF8_CHAR("A",  0), 1);
  64 ok(&Devel::PPPort::isUTF8_CHAR("\x{100}",  -1), 0);
  65 ok(&Devel::PPPort::isUTF8_CHAR("\x{100}",  0), 2);
  66
  67 my $ret = &Devel::PPPort::utf8_to_uvchr("A");
  68 ok($ret->[0], ord("A"));
  69 ok($ret->[1], 1);
  70
  71 $ret = &Devel::PPPort::utf8_to_uvchr("\0");
  72 ok($ret->[0], 0);
  73 ok($ret->[1], 1);
  74
  75 $ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
  76 ok($ret->[0], ord("A"));
  77 ok($ret->[1], 1);
  78
  79 $ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
  80 ok($ret->[0], 0);
  81 ok($ret->[1], 1);
  82
  83 if (ord("A") != 65) {   # tests not valid for EBCDIC
  84     ok(1, 1) for 1 .. (2 + 4 + (7 * 5));
  85 }
  86 else {
  87     $ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
  88     ok($ret->[0], 0x100);
  89     ok($ret->[1], 2);
  90
  91     my @warnings;
  92     local $SIG{__WARN__} = sub { push @warnings, @_; };
  93
  94     {
  95         BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
  96         $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
  97         ok($ret->[0], 0);
  98         ok($ret->[1], -1);
  99
 100         BEGIN { 'warnings'->unimport() if "$]" gt '5.006' }
 101         $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
 102         ok($ret->[0], 0xFFFD);
 103         ok($ret->[1], 1);
 104     }
 105
 106     my @buf_tests = (
 107         {
 108             input      => "A",
 109             adjustment => -1,
 110             warning    => qr/empty/,
 111             no_warnings_returned_length => 0,
 112         },
 113         {
 114             input      => "\xc4\xc5",
 115             adjustment => 0,
 116             warning    => qr/non-continuation/,
 117             no_warnings_returned_length => 1,
 118         },
 119         {
 120             input      => "\xc4\x80",
 121             adjustment => -1,
 122             warning    => qr/short|1 byte, need 2/,
 123             no_warnings_returned_length => 1,
 124         },
 125         {
 126             input      => "\xc0\x81",
 127             adjustment => 0,
 128             warning    => qr/overlong|2 bytes, need 1/,
 129             no_warnings_returned_length => 2,
 130         },
 131         {
 132             input      => "\xe0\x80\x81",
 133             adjustment => 0,
 134             warning    => qr/overlong|3 bytes, need 1/,
 135             no_warnings_returned_length => 3,
 136         },
 137         {
 138             input      => "\xf0\x80\x80\x81",
 139             adjustment => 0,
 140             warning    => qr/overlong|4 bytes, need 1/,
 141             no_warnings_returned_length => 4,
 142         },
 143         {                 # Old algorithm failed to detect this
 144             input      => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf",
 145             adjustment => 0,
 146             warning    => qr/overflow/,
 147             no_warnings_returned_length => 13,
 148         },
 149     );
 150
 151     # An empty input is an assertion failure on debugging builds.  It is
 152     # deliberately the first test.
 153     require Config; import Config;
 154     use vars '%Config';
 155     if ($Config{ccflags} =~ /-DDEBUGGING/) {
 156         shift @buf_tests;
 157         ok(1, 1) for 1..5;
 158     }
 159
 160     for my $test (@buf_tests) {
 161         my $input = $test->{'input'};
 162         my $adjustment = $test->{'adjustment'};
 163         my $display = 'utf8_to_uvchr_buf("';
 164         for (my $i = 0; $i < length($input) + $adjustment; $i++) {
 165             $display .= sprintf "\\x%02x", ord substr($input, $i, 1);
 166         }
 167
 168         $display .= '")';
 169         my $warning = $test->{'warning'};
 170
 171         undef @warnings;
 172         BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
 173         $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
 174         ok($ret->[0], 0,  "returned value $display; warnings enabled");
 175         ok($ret->[1], -1, "returned length $display; warnings enabled");
 176         my $all_warnings = join "; ", @warnings;
 177         my $contains = grep { $_ =~ $warning } $all_warnings;
 178         ok($contains, 1, $display
 179                     . "; Got: '$all_warnings', which should contain '$warning'");
 180
 181         undef @warnings;
 182         BEGIN { 'warnings'->unimport('utf8') if "$]" gt '5.006' }
 183         $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
 184         ok($ret->[0], 0xFFFD,  "returned value $display; warnings disabled");
 185         ok($ret->[1], $test->{'no_warnings_returned_length'},
 186                       "returned length $display; warnings disabled");
 187     }
 188 }
 189