Re: [PATCH] ...while $var = glob(...)

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

diff --git a/t/op/pack.t b/t/op/pack.t
index 75ddd1e..f6f9448 100755 (executable)
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 1470;
+plan tests => 1476;
 
 use strict;
 use warnings;
@@ -15,24 +15,8 @@ use Config;
 my $Is_EBCDIC = (defined $Config{ebcdic} && $Config{ebcdic} eq 'define');
 my $Perl = which_perl();
 
-sub encode {
-  my @result = @_;
-  foreach (@result) {
-    s/([[:cntrl:]\177 ])/sprintf "\\%03o", ord $1/ge if defined;
-  }
-  @result;
-}
-
 sub encode_list {
-  my @result = @_;
-  foreach (@result) {
-    if (defined) {
-      s/([[:cntrl:]\177])/sprintf "\\%03o", ord $1/ge;
-      $_ = qq("$_");
-    } else {
-      $_ = 'undef';
-    }
-  }
+  my @result = map {_qq($_)} @_;
   if (@result == 1) {
     return @result;
   }
@@ -284,9 +268,9 @@ foreach (
     my ($what, $template, $in, $out) = @$_;
     my $got = $what eq 'u' ? (unpack $template, $in) : (pack $template, $in);
     unless (is($got, $out)) {
-        ($in, $out, $got) = encode ($in, $out, $got);
         my $un = $what eq 'u' ? 'un' : '';
-        print "# ${un}pack ('$template', \"$in\") gave $out not $got\n";
+        print "# ${un}pack ('$template', "._qq($in).') gave '._qq($out).
+            ' not '._qq($got)."\n";
     }
 }
 
@@ -385,14 +369,13 @@ sub numbers_with_total {
             $calc_sum = 0;
         }
 
-        if (is( $calc_sum, $sum)) {
-            print "# unpack '%$_$format' gave $sum\n";
+        if ($calc_sum == $sum) { # HAS to be ==, not eq (so no is()).
+            ok ("unpack '%$_$format' gave $sum");
         } else {
             my $delta = 1.000001;
             if ($format =~ tr /dDfF//
                 && ($calc_sum <= $sum * $delta && $calc_sum >= $sum / $delta)) {
-                pass;
-                print "# unpack '%$_$format' gave $sum, expected $calc_sum\n";
+                pass ("unpack '%$_$format' gave $sum, expected $calc_sum");
             } else {
                 my $text = ref $total ? &$total($len) : $total;
                 fail;
@@ -459,25 +442,40 @@ is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde");
   my ($x, $y, $z);
   eval { ($x) = unpack '/a*','hello' };
   like($@, qr!/ must follow a numeric type!);
+  undef $x;
+  eval { $x = unpack '/a*','hello' };
+  like($@, qr!/ must follow a numeric type!);
 
+  undef $x;
   eval { ($z,$x,$y) = unpack 'a3/A C/a* C/Z', "003ok \003yes\004z\000abc" };
   is($@, '');
   is($z, 'ok');
   is($x, 'yes');
   is($y, 'z');
+  undef $z;
+  eval { $z = unpack 'a3/A C/a* C/Z', "003ok \003yes\004z\000abc" };
+  is($@, '');
+  is($z, 'ok');
+
 
+  undef $x;
   eval { ($x) = pack '/a*','hello' };
   like($@,  qr!Invalid type in pack: '/'!);
+  undef $x;
+  eval { $x = pack '/a*','hello' };
+  like($@,  qr!Invalid type in pack: '/'!);
 
   $z = pack 'n/a* N/Z* w/A*','string','hi there ','etc';
   my $expect = "\000\006string\0\0\0\012hi there \000\003etc";
   is($z, $expect);
 
+  undef $x;
   $expect = 'hello world';
   eval { ($x) = unpack ("w/a", chr (11) . "hello world!")};
   is($x, $expect);
   is($@, '');
 
+  undef $x;
   # Doing this in scalar context used to fail.
   eval { $x = unpack ("w/a", chr (11) . "hello world!")};
   is($@, '');
@@ -490,12 +488,14 @@ is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde");
   ) 
   {
     my ($pat, $in, $expect) = @$_;
+    undef $x;
     eval { ($x) = unpack $pat, $in };
     is($@, '');
     is($x, $expect) || 
       printf "# list unpack ('$pat', '$in') gave %s, expected '$expect'\n",
              encode_list ($x);
 
+    undef $x;
     eval { $x = unpack $pat, $in };
     is($@, '');
     is($x, $expect) ||
@@ -505,25 +505,30 @@ is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde");
 
   # / with #
 
-  eval { ($z,$x,$y) = unpack <<EOU, "003ok \003yes\004z\000abc" };
+  my $pattern = <<'EOU';
  a3/A                  # Count in ASCII
  C/a*                  # Count in a C char
  C/Z                   # Count in a C char but skip after \0
 EOU
 
+  $x = $y = $z =undef;
+  eval { ($z,$x,$y) = unpack $pattern, "003ok \003yes\004z\000abc" };
   is($@, '');
   is($z, 'ok');
   is($x, 'yes');
   is($y, 'z');
+  undef $x;
+  eval { $z = unpack $pattern, "003ok \003yes\004z\000abc" };
+  is($@, '');
+  is($z, 'ok');
 
-  $z = pack <<EOP,'string','etc';
+  $pattern = <<'EOP';
   n/a*                 # Count as network short
   w/A*                 # Count a  BER integer
 EOP
   $expect = "\000\006string\003etc";
-
-  is($z, $expect) ||
-    printf "# got '%s', expected '$expect'\n", encode $z;
+  $z = pack $pattern,'string','etc';
+  is($z, $expect);
 }
 
 is("1.20.300.4000", sprintf "%vd", pack("U*",1,20,300,4000));
@@ -642,15 +647,15 @@ foreach (
   my @got = eval {unpack $template, $in};
   is($@, '');
   list_eq (\@got, \@out) ||
-    printf "# list unpack ('$template', \"%s\") gave %s expected %s\n",
-           encode ($in), encode_list (@got), encode_list (@out);
+    printf "# list unpack ('$template', %s) gave %s expected %s\n",
+           _qq($in), encode_list (@got), encode_list (@out);
 
   my $got = eval {unpack $template, $in};
   is($@, '');
   @out ? is( $got, $out[0] ) # 1 or more items; should get first
        : ok( !defined $got ) # 0 items; should get undef
-    or printf "# scalar unpack ('$template', \"%s\") gave %s expected %s\n",
-              encode ($in), encode_list ($got), encode_list ($out[0]);
+    or printf "# scalar unpack ('$template', %s) gave %s expected %s\n",
+              _qq($in), encode_list ($got), encode_list ($out[0]);
 }
 
 {