Re: pack and ASCII

Front page | perl.perl5.porters | Postings from January 2012

Thread Previous | Thread Next

From:

Eric Brine

Date:

January 12, 2012 12:54

Subject:

Re: pack and ASCII

Message ID:

CALJW-qEuyL6tbtpNt6xU1BmDd_eU9QD4qxRpBDkRVPsUoLuppw@mail.gmail.com


# perl test.pl
#    -or-
# perl -MInline=FORCE,NOISY,NOCLEAN test.pl

use strict;
use warnings;

use Test::More tests => 26;


use Inline C => <<'__EOI__';

   SV * cfunction(SV * sv) {
      STRLEN len;
      char*  buf;
      AV*    av = newAV();

      SvGETMAGIC(sv);
      buf = SvPVbyte(sv, len);
      while (len--)
         av_push(av, newSViv((unsigned char)*(buf++)));

      return newRV_noinc(av);
   }

__EOI__


my $warn_count = 0;
local $SIG{__WARN__} = sub { ++$warn_count };

sub _u { my $_ = $_[0]; utf8::upgrade($_); $_ }
sub _d { my $_ = $_[0]; utf8::upgrade($_); $_ }

my @bytes = (
   _d(chr(0x41)),
   _u(chr(0x41)),
   _d(chr(0xE9)),
   _u(chr(0xE9)),
);

# Test that we get no errors from IO when we expect no errors.
for my $byte (@bytes) {
   my $struct = '';
   $warn_count = 0;
   my $success = eval {
      open(my $fh, '>', \$struct) or die;
      print($fh pack("A20", $byte)) or die;
      close($fh) or die;
      1
   };
   $success &&= $warn_count == 0;

   ok($success);
   is(length($struct), 20);
   is($struct, $byte . (' 'x19));
}

# Test that we get no errors from data interchange when we expect no errors.
for my $byte (@bytes) {
   $warn_count = 0;
   my $result = eval { cfunction(pack("A20", $byte)) };
   my $success = $result && $warn_count == 0;

   ok($success);
   is(0+@$result, 20);
   is_deeply($result, [ ord($byte), (0x20)x19 ]);
}

# Test that we get error from IO when we expect one.
{
   my $struct = '';
   $warn_count = 0;
   my $success = eval {
      open(my $fh, '>', \$struct) or die;
      print($fh pack("A20", chr(0x2660))) or die;
      close($fh) or die;
      1
   };
   $success &&= $warn_count == 0;

   ok(!$success);
}

# Test that we get error from data interchange when we expect one.
{
   $warn_count = 0;
   my $result = eval { cfunction(pack("A20", chr(0x2660))) };
   my $success = $result && $warn_count == 0;

   ok(!$success);
}

1;

Thread Previous | Thread Next