Non-VMS-fixed and Win32-skipped version of

[p5sagit/p5-mst-13.2.git] / t / op / pack.t

diff --git a/t/op/pack.t b/t/op/pack.t
index bb1ddd5..2fd1312 100755 (executable)
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -1,6 +1,6 @@
 #!./perl -w
 
-print "1..613\n";
+print "1..615\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -409,7 +409,8 @@ sub numbers_with_total {
         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";
       }
@@ -556,7 +557,9 @@ ok ("@{[unpack('U*', pack('U*', 100, 200, 300))]}" eq "100 200 300");
 # is unpack U the reverse of pack U for byte string?
 ok ("@{[unpack('U*', pack('U*', 100, 200))]}" eq "100 200");
 
-if (ord('A') == 65) {
+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");
 
@@ -565,15 +568,13 @@ if (ord('A') == 65) {
 
     # does pack C0U create characters?
     ok ("@{[pack('C0U*', 100, 200)]}" eq pack("C*", 100, 195, 136));
-} else {
-    ok(1, undef, "skipped") for 1..3; # EBCDIC?
-}
 
-# 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, $@);
+    }
 }
 
 {
@@ -675,3 +676,31 @@ foreach (
 
     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/);
+}