#!./perl -w
-print "1..611\n";
+print "1..615\n";
BEGIN {
chdir 't' if -d 't';
} else {
if ($err) {
chomp $err;
- print "not ok $test # \$\@ = $err\n";
+ print "not ok $test # $err\n";
} else {
if (defined $wrong) {
$wrong = ", got $wrong";
print "ok $test # unpack '%$_$format' gave $sum,"
. " expected $calc_sum\n";
} else {
- print "not ok $test # For list (" . join (", ", @_) . ") (total $total)"
+ my $text = ref $total ? &$total($len) : $total;
+ print "not ok $test # For list (" . join (", ", @_) . ") (total $text)"
. " packed with $format unpack '%$_$format' gave $sum,"
. " expected $calc_sum\n";
}
# is unpack U the reverse of pack U for byte string?
ok ("@{[unpack('U*', pack('U*', 100, 200))]}" eq "100 200");
-# does unpack C unravel pack U?
-ok ("@{[unpack('C*', pack('U*', 100, 200))]}" eq "100 195 136");
+if (ord('A') == 193) {
+ ok(1, undef, "skipped") for 1..4; # EBCDIC
+} else {
+ # does unpack C unravel pack U?
+ ok ("@{[unpack('C*', pack('U*', 100, 200))]}" eq "100 195 136");
-# does pack U0C create Unicode?
-ok ("@{[pack('U0C*', 100, 195, 136)]}" eq v100.v200);
+ # does pack U0C create Unicode?
+ ok ("@{[pack('U0C*', 100, 195, 136)]}" eq v100.v200);
-# does pack C0U create characters?
-ok ("@{[pack('C0U*', 100, 200)]}" eq pack("C*", 100, 195, 136));
+ # does pack C0U create characters?
+ ok ("@{[pack('C0U*', 100, 200)]}" eq pack("C*", 100, 195, 136));
-# does unpack U0U on byte data warn?
-{
- local $SIG{__WARN__} = sub { $@ = "@_" };
- my @null = unpack('U0U', chr(255));
- ok ($@ =~ /^Malformed UTF-8 character /, undef, $@);
+ # does unpack U0U on byte data warn?
+ {
+ local $SIG{__WARN__} = sub { $@ = "@_" };
+ my @null = unpack('U0U', chr(255));
+ ok ($@ =~ /^Malformed UTF-8 character /, undef, $@);
+ }
}
{
my @u = unpack($t, $p);
ok(@u == 2 && $u[0] eq $u && $u[1] eq $v);
}
+
+{
+ # 612
+
+ ok((unpack("w/a*", "\x02abc"))[0] eq "ab");
+
+ # 613: "w/a*" should be seen as one unit
+
+ ok(scalar unpack("w/a*", "\x02abc") eq "ab");
+}
+
+{
+ # 614
+
+ # from Wolfgang Laun: fix in change #13163
+
+ my $s = 'ABC' x 10;
+ my $x = 42;
+ my $buf = pack( 'Z*/A* C', $s, $x );
+ my $y;
+
+ my $h = $buf;
+ $h =~ s/[^[:print:]]/./g;
+ ( $s, $y ) = unpack( "Z*/A* C", $buf );
+ ok($h eq "30.ABCABCABCABCABCABCABCABCABCABC*" &&
+ length $buf == 34 &&
+ $s eq "ABCABCABCABCABCABCABCABCABCABC" &
+ $y == 42);
+}
+
+{
+ # 615
+
+ # from Wolfgang Laun: fix in change #13288
+
+ eval { my $t=unpack("P*", "abc") };
+ ok($@ =~ /P must have an explicit size/);
+}