Avoid generating thousands of UTF-8 warnings when testing under a
Nicholas Clark [Tue, 19 Apr 2005 14:25:00 +0000 (14:25 +0000)]
UTF-8 locale

p4raw-id: //depot/perl@24251

t/op/pack.t

index 66d2ee6..a41ef8d 100755 (executable)
@@ -15,7 +15,7 @@ my $no_signedness = $] > 5.009 ? '' :
 plan tests => 14697;
 
 use strict;
-use warnings;
+use warnings qw(FATAL all);
 use Config;
 
 my $Is_EBCDIC = (defined $Config{ebcdic} && $Config{ebcdic} eq 'define');
@@ -129,6 +129,7 @@ sub list_eq ($$) {
 
     my $foo;
     open(BIN, $Perl) || die "Can't open $Perl: $!\n";
+    binmode BIN;
     sysread BIN, $foo, 8192;
     close BIN;
 
@@ -368,7 +369,7 @@ SKIP: {
 # 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];
@@ -943,6 +944,8 @@ SKIP: {
 
     # 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);
@@ -1191,11 +1194,6 @@ SKIP: {
 }
 
 {  # 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' );
@@ -1234,7 +1232,7 @@ SKIP: {
 }
 
 { # syntax checks (W.Laun)
-  use warnings;
+  use warnings qw(NONFATAL all);;
   my @warning;
   local $SIG{__WARN__} = sub {
       push( @warning, $_[0] );
@@ -1405,6 +1403,7 @@ is(scalar unpack('A /A /A Z20', '3004bcde'), 'bcde');
   $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];
@@ -1496,6 +1495,7 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
 }
 
 {
+    use warnings qw(NONFATAL all);;
     my $warning;
     local $SIG{__WARN__} = sub {
         $warning = $_[0];