my $no_signedness = $] > 5.009 ? '' :
"Signed/unsigned pack modifiers not available on this perl";
-plan tests => 14697;
+plan tests => 14696;
use strict;
-use warnings;
+use warnings qw(FATAL all);
use Config;
my $Is_EBCDIC = (defined $Config{ebcdic} && $Config{ebcdic} eq 'define');
}
for my $size ( 16, 32, 64 ) {
- if (exists $Config{"u${size}size"} and $Config{"u${size}size"} != ($size >> 3)) {
+ if (defined $Config{"u${size}size"} and ($Config{"u${size}size"}||0) != ($size >> 3)) {
push @valid_errors, qr/^Perl_my_$maybe_not_avail$size\(\) not available/;
}
}
my $foo;
open(BIN, $Perl) || die "Can't open $Perl: $!\n";
+ binmode BIN;
sysread BIN, $foo, 8192;
close BIN;
# temps
sub foo { my $a = "a"; return $a . $a++ . $a++ }
{
- use warnings;
+ use warnings qw(NONFATAL all);;
my $warning;
local $SIG{__WARN__} = sub {
$warning = $_[0];
skip "cannot pack '$format' on this perl", 5
if is_valid_error($@);
- print "# [$value][$nat][$be][$le][$@]\n";
+ {
+ use warnings qw(NONFATAL utf8);
+ print "# [$value][$nat][$be][$le][$@]\n";
+ }
SKIP: {
skip "cannot compare native byteorder with big-/little-endian", 1
isnt(v1.20.300.4000, sprintf "%vd", pack("C0U*",1,20,300,4000));
my $rslt = $Is_EBCDIC ? "156 67" : "199 162";
-is(join(" ", unpack("C*", chr(0x1e2))), $rslt);
+is(join(" ", unpack("U0 C*", chr(0x1e2))), $rslt);
# does pack U create Unicode?
is(ord(pack('U', 300)), 300);
SKIP: {
skip "Not for EBCDIC", 4 if $Is_EBCDIC;
- # does unpack C unravel pack U?
- is("@{[unpack('C*', pack('U*', 100, 200))]}", "100 195 136");
-
# does pack U0C create Unicode?
is("@{[pack('U0C*', 100, 195, 136)]}", v100.v200);
# does unpack U0U on byte data warn?
{
+ use warnings qw(NONFATAL all);;
+
my $bad = pack("U0C", 255);
local $SIG{__WARN__} = sub { $@ = "@_" };
my @null = unpack('U0U', $bad);
}
{ # more on grouping (W.Laun)
- use warnings;
- my $warning;
- local $SIG{__WARN__} = sub {
- $warning = $_[0];
- };
# @ absolute within ()-group
my $badc = pack( '(a)*', unpack( '(@1a @0a @2)*', 'abcd' ) );
is( $badc, 'badc' );
}
{ # syntax checks (W.Laun)
- use warnings;
+ use warnings qw(NONFATAL all);;
my @warning;
local $SIG{__WARN__} = sub {
push( @warning, $_[0] );
my $p = eval { pack $junk1, @list2 };
skip "cannot pack '$type' on this perl", 12
if is_valid_error($@);
+ die "pack $junk1 failed: $@" if $@;
my $half = int( (length $p)/2 );
for my $move ('', "X$half", "X!$half", 'x1', 'x!8', "x$half") {
$b =~ s/(?:17000+|16999+)\d+(e-45) /17$1 /gi; # stringification is gamble
is($b, "@a @a");
+ use warnings qw(NONFATAL all);;
my $warning;
local $SIG{__WARN__} = sub {
$warning = $_[0];
is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
{
- my $a = "X\t01234567\n" x 100;
+ my $a = "X\x0901234567\n" x 100; # \t would not be EBCDIC TAB
my @a = unpack("(a1 c/a)*", $a);
is(scalar @a, 200, "[perl #15288]");
is($a[-1], "01234567\n", "[perl #15288]");
}
{
+ use warnings qw(NONFATAL all);;
my $warning;
local $SIG{__WARN__} = sub {
$warning = $_[0];
is($x[1], $y[1], "checksum advance ok");
# verify that the checksum is not overflowed with C0
- is(unpack("C0%128U", "abcd"), unpack("U0%128U", "abcd"), "checksum not overflowed");
+ if (ord('A') == 193) {
+ is(unpack("C0%128U", "/bcd"), unpack("U0%128U", "abcd"), "checksum not overflowed");
+ } else {
+ is(unpack("C0%128U", "abcd"), unpack("U0%128U", "abcd"), "checksum not overflowed");
+ }
}
{
{
# counted length prefixes shouldn't change C0/U0 mode
# (note the length is actually 0 in this test)
- is(join(',', unpack("aC/UU", "b\0\341\277\274")), 'b,8188');
- is(join(',', unpack("aC/CU", "b\0\341\277\274")), 'b,8188');
- is(join(',', unpack("aU0C/UU", "b\0\341\277\274")), 'b,225');
- is(join(',', unpack("aU0C/CU", "b\0\341\277\274")), 'b,225');
+ if (ord('A') == 193) {
+ is(join(',', unpack("aU0C/UU", "b\0\341\277\274")), 'b,0');
+ is(join(',', unpack("aU0C/CU", "b\0\341\277\274")), 'b,0');
+ } else {
+ is(join(',', unpack("aC/UU", "b\0\341\277\274")), 'b,8188');
+ is(join(',', unpack("aC/CU", "b\0\341\277\274")), 'b,8188');
+ is(join(',', unpack("aU0C/UU", "b\0\341\277\274")), 'b,225');
+ is(join(',', unpack("aU0C/CU", "b\0\341\277\274")), 'b,225');
+ }
}
{
}
{
- # C is *not* neutral
+ # C *is* neutral
my $down = "\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff\x05\x06";
my $up = $down;
utf8::upgrade($up);
is(pack("C*", @down), $down, "byte join");
my @up = unpack("C*", $up);
- my @expect_up = (0xc3, 0xb8, 0xc3, 0xb9, 0xc3, 0xba, 0xc3, 0xbb, 0xc3, 0xbc, 0xc3, 0xbd, 0xc3, 0xbe, 0xc3, 0xbf, 0x05, 0x06);
+ my @expect_up = (0xf8, 0xf9, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff, 0x05, 0x06);
is("@up", "@expect_up", "UTF-8 expand");
is(pack("U0C0C*", @up), $up, "UTF-8 join");
}