Front page | perl.perl5.porters |
Postings from January 2012
Re: pack and ASCII
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