dist/Devel-PPPort/t/uv.t

   1 ################################################################################
   2 #
   3 #            !!!!!   Do NOT edit this file directly!   !!!!!
   4 #
   5 #            Edit mktests.PL and/or parts/inc/uv 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 (11) {
  34     load();
  35     plan(tests => 11);
  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 "$]" > '5.006' }
  52
  53 ok(&Devel::PPPort::sv_setuv(42), 42);
  54 ok(&Devel::PPPort::newSVuv(123), 123);
  55 ok(&Devel::PPPort::sv_2uv("4711"), 4711);
  56 ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
  57 ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
  58 ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
  59 ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
  60 ok(&Devel::PPPort::XSRETURN_UV(), 42);
  61 ok(&Devel::PPPort::PUSHu(), 42);
  62 ok(&Devel::PPPort::XPUSHu(), 43);
  63 ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
  64
  65 # skip tests on 5.6.0 and earlier
  66 if ("$]" le '5.006') {
  67     skip 'skip: broken utf8 support', 0 for 1..51;
  68     exit;
  69 }
  70
  71 ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
  72 ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
  73
  74 my $ret = &Devel::PPPort::utf8_to_uvchr("A");
  75 ok($ret->[0], ord("A"));
  76 ok($ret->[1], 1);
  77
  78 $ret = &Devel::PPPort::utf8_to_uvchr("\0");
  79 ok($ret->[0], 0);
  80 ok($ret->[1], 1);
  81
  82 $ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
  83 ok($ret->[0], ord("A"));
  84 ok($ret->[1], 1);
  85
  86 $ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
  87 ok($ret->[0], 0);
  88 ok($ret->[1], 1);
  89
  90 if (ord("A") != 65) {   # tests not valid for EBCDIC
  91     ok(1, 1) for 1 .. (2 + 4 + (7 * 5));
  92 }
  93 else {
  94     $ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
  95     ok($ret->[0], 0x100);
  96     ok($ret->[1], 2);
  97
  98     my @warnings;
  99     local $SIG{__WARN__} = sub { push @warnings, @_; };
 100
 101     {
 102         BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
 103         $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
 104         ok($ret->[0], 0);
 105         ok($ret->[1], -1);
 106
 107         BEGIN { 'warnings'->unimport() if "$]" gt '5.006' }
 108         $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
 109         ok($ret->[0], 0xFFFD);
 110         ok($ret->[1], 1);
 111     }
 112
 113     my @buf_tests = (
 114         {
 115             input      => "A",
 116             adjustment => -1,
 117             warning    => qr/empty/,
 118             no_warnings_returned_length => 0,
 119         },
 120         {
 121             input      => "\xc4\xc5",
 122             adjustment => 0,
 123             warning    => qr/non-continuation/,
 124             no_warnings_returned_length => 1,
 125         },
 126         {
 127             input      => "\xc4\x80",
 128             adjustment => -1,
 129             warning    => qr/short|1 byte, need 2/,
 130             no_warnings_returned_length => 1,
 131         },
 132         {
 133             input      => "\xc0\x81",
 134             adjustment => 0,
 135             warning    => qr/overlong|2 bytes, need 1/,
 136             no_warnings_returned_length => 2,
 137         },
 138         {
 139             input      => "\xe0\x80\x81",
 140             adjustment => 0,
 141             warning    => qr/overlong|3 bytes, need 1/,
 142             no_warnings_returned_length => 3,
 143         },
 144         {
 145             input      => "\xf0\x80\x80\x81",
 146             adjustment => 0,
 147             warning    => qr/overlong|4 bytes, need 1/,
 148             no_warnings_returned_length => 4,
 149         },
 150         {                 # Old algorithm failed to detect this
 151             input      => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf",
 152             adjustment => 0,
 153             warning    => qr/overflow/,
 154             no_warnings_returned_length => 13,
 155         },
 156     );
 157
 158     # An empty input is an assertion failure on debugging builds.  It is
 159     # deliberately the first test.
 160     require Config; import Config;
 161     use vars '%Config';
 162     if ($Config{ccflags} =~ /-DDEBUGGING/
 163         || $^O eq 'VMS' && $Config{usedebugging_perl} eq 'Y') {
 164         shift @buf_tests;
 165         ok(1, 1) for 1..5;
 166     }
 167
 168     for my $test (@buf_tests) {
 169         my $input = $test->{'input'};
 170         my $adjustment = $test->{'adjustment'};
 171         my $display = 'utf8_to_uvchr_buf("';
 172         for (my $i = 0; $i < length($input) + $adjustment; $i++) {
 173             $display .= sprintf "\\x%02x", ord substr($input, $i, 1);
 174         }
 175
 176         $display .= '")';
 177         my $warning = $test->{'warning'};
 178
 179         undef @warnings;
 180         BEGIN { 'warnings'->import('utf8') if "$]" gt '5.006' }
 181         $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
 182         ok($ret->[0], 0,  "returned value $display; warnings enabled");
 183         ok($ret->[1], -1, "returned length $display; warnings enabled");
 184         my $all_warnings = join "; ", @warnings;
 185         my $contains = grep { $_ =~ $warning } $all_warnings;
 186         ok($contains, 1, $display
 187                     . "; Got: '$all_warnings', which should contain '$warning'");
 188
 189         undef @warnings;
 190         BEGIN { 'warnings'->unimport('utf8') if "$]" gt '5.006' }
 191         $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
 192         ok($ret->[0], 0xFFFD,  "returned value $display; warnings disabled");
 193         ok($ret->[1], $test->{'no_warnings_returned_length'},
 194                       "returned length $display; warnings disabled");
 195     }
 196 }
 197