warnings for perlio + others

From: "Paul Marquess" <paul_marquess@yahoo.co.uk>
Message-ID: <AIEAJICLCBDNAAOLLOKLMEKNEAAA.paul_marquess@yahoo.co.uk>

p4raw-id: //depot/perl@15485

diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs
index d1d4e64..af5f5ea 100644 (file)
--- a/ext/PerlIO/Via/Via.xs
+++ b/ext/PerlIO/Via/Via.xs
@@ -115,7 +115,8 @@ PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
    PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
    if (!arg)
     {
-     Perl_warn(aTHX_ "No package specified");
+     if (ckWARN(WARN_LAYER))
+      Perl_warner(aTHX_ packWARN(WARN_LAYER), "No package specified");
      code = -1;
     }
    else
@@ -145,7 +146,8 @@ PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
       }
      else
       {
-       Perl_warn(aTHX_ "Cannot find package '%.*s'",(int) pkglen,pkg);
+       if (ckWARN(WARN_LAYER))
+         Perl_warner(aTHX_ packWARN(WARN_LAYER), "Cannot find package '%.*s'",(int) pkglen,pkg);
 #ifdef ENOSYS
        errno = ENOSYS;
 #else

diff --git a/ext/PerlIO/t/via.t b/ext/PerlIO/t/via.t
index a2201e0..89a1e13 100644 (file)
--- a/ext/PerlIO/t/via.t
+++ b/ext/PerlIO/t/via.t
@@ -1,5 +1,8 @@
 #!./perl
 
+use strict;
+use warnings;
+
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
@@ -11,22 +14,38 @@ BEGIN {
 
 my $tmp = "via$$";
 
-print "1..3\n";
+use Test::More tests => 11;
+
+my $fh;
+my $a = join("", map { chr } 0..255) x 10;
+my $b;
 
-$a = join("", map { chr } 0..255) x 10;
+BEGIN { use_ok('MIME::QuotedPrint'); }
 
-use MIME::QuotedPrint;
-open(my $fh,">Via(MIME::QuotedPrint)", $tmp);
-print $fh $a;
-close($fh);
-print "ok 1\n";
+ok( open($fh,">Via(MIME::QuotedPrint)", $tmp), 'open QuotedPrint for output');
+ok( (print $fh $a), "print to output file");
+ok( close($fh), 'close output file');
 
-open(my $fh,"<Via(MIME::QuotedPrint)", $tmp);
+ok( open($fh,"<Via(MIME::QuotedPrint)", $tmp), 'open QuotedPrint for input');
 { local $/; $b = <$fh> }
-close($fh);
-print "ok 2\n";
+ok( close($fh), "close input file");
+
+is($a, $b, 'compare original data with filtered version');
+
+
+{
+    my $warnings = '';
+    local $SIG{__WARN__} = sub { $warnings = join '', @_ };
+
+    use warnings 'layer';
+    ok( ! open($fh,">Via(Unknown::Module)", $tmp), 'open Via Unknown::Module will fail');
+    like( $warnings, qr/^Cannot find package 'Unknown::Module'/,  'warn about unknown package' );
 
-print "ok 3\n" if $a eq $b;
+    $warnings = '';
+    no warnings 'layer';
+    ok( ! open($fh,">Via(Unknown::Module)", $tmp), 'open Via Unknown::Module will fail');
+    is( $warnings, "",  "don't warn about unknown package" );
+}    
 
 END {
     1 while unlink $tmp;

diff --git a/lib/open.pm b/lib/open.pm
index f66cb5b..a5c337a 100644 (file)
--- a/lib/open.pm
+++ b/lib/open.pm
@@ -1,4 +1,5 @@
 package open;
+use warnings;
 use Carp;
 $open::hint_bits = 0x20000;
 
@@ -81,7 +82,7 @@ sub import {
                use Encode;
                _get_locale_encoding()
                    unless defined $locale_encoding;
-               (carp("Cannot figure out an encoding to use"), last)
+               (warnings::warnif("layer", "Cannot figure out an encoding to use"), last)
                    unless defined $locale_encoding;
                if ($locale_encoding =~ /^utf-?8$/i) {
                    $layer = "utf8";
@@ -94,7 +95,7 @@ sub import {
                $target =~ s/^(\w+)\(.+\)$/$1/; # strip parameters
 
                unless(PerlIO::Layer::->find($target)) {
-                   carp("Unknown discipline layer '$layer'");
+                   warnings::warnif("layer", "Unknown discipline layer '$layer'");
                }
            }
            push(@val,":$layer");

diff --git a/lib/open.t b/lib/open.t
index 5897c2b..bb5d829 100644 (file)
--- a/lib/open.t
+++ b/lib/open.t
@@ -6,7 +6,7 @@ BEGIN {
        require Config; import Config;
 }
 
-use Test::More tests => 15;
+use Test::More tests => 16;
 
 # open::import expects 'open' as its first argument, but it clashes with open()
 sub import {
@@ -32,7 +32,13 @@ local $SIG{__WARN__} = sub {
 };
 
 # and it shouldn't be able to find this discipline
-eval{ import( 'IN', 'macguffin' ) };
+$warn = '';
+eval q{ no warnings 'layer'; use open IN => ':macguffin' ; };
+is( $warn, '',
+       'should not warn about unknown discipline with bad discipline provided' );
+
+$warn = '';
+eval q{ use warnings 'layer'; use open IN => ':macguffin' ; };
 like( $warn, qr/Unknown discipline layer/, 
        'should warn about unknown discipline with bad discipline provided' );
 

diff --git a/lib/warnings.pm b/lib/warnings.pm
index 8c47913..7f7e175 100644 (file)
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -137,143 +137,146 @@ use Carp ;
     'io'               => 10,
     'closed'           => 12,
     'exec'             => 14,
-    'newline'          => 16,
-    'pipe'             => 18,
-    'unopened'         => 20,
-    'misc'             => 22,
-    'numeric'          => 24,
-    'once'             => 26,
-    'overflow'         => 28,
-    'pack'             => 30,
-    'portable'         => 32,
-    'recursion'                => 34,
-    'redefine'         => 36,
-    'regexp'           => 38,
-    'severe'           => 40,
-    'debugging'                => 42,
-    'inplace'          => 44,
-    'internal'         => 46,
-    'malloc'           => 48,
-    'signal'           => 50,
-    'substr'           => 52,
-    'syntax'           => 54,
-    'ambiguous'                => 56,
-    'bareword'         => 58,
-    'digit'            => 60,
-    'parenthesis'      => 62,
-    'precedence'       => 64,
-    'printf'           => 66,
-    'prototype'                => 68,
-    'qw'               => 70,
-    'reserved'         => 72,
-    'semicolon'                => 74,
-    'taint'            => 76,
-    'uninitialized'    => 78,
-    'unpack'           => 80,
-    'untie'            => 82,
-    'utf8'             => 84,
-    'void'             => 86,
-    'y2k'              => 88,
+    'layer'            => 16,
+    'newline'          => 18,
+    'pipe'             => 20,
+    'unopened'         => 22,
+    'misc'             => 24,
+    'numeric'          => 26,
+    'once'             => 28,
+    'overflow'         => 30,
+    'pack'             => 32,
+    'portable'         => 34,
+    'recursion'                => 36,
+    'redefine'         => 38,
+    'regexp'           => 40,
+    'severe'           => 42,
+    'debugging'                => 44,
+    'inplace'          => 46,
+    'internal'         => 48,
+    'malloc'           => 50,
+    'signal'           => 52,
+    'substr'           => 54,
+    'syntax'           => 56,
+    'ambiguous'                => 58,
+    'bareword'         => 60,
+    'digit'            => 62,
+    'parenthesis'      => 64,
+    'precedence'       => 66,
+    'printf'           => 68,
+    'prototype'                => 70,
+    'qw'               => 72,
+    'reserved'         => 74,
+    'semicolon'                => 76,
+    'taint'            => 78,
+    'uninitialized'    => 80,
+    'unpack'           => 82,
+    'untie'            => 84,
+    'utf8'             => 86,
+    'void'             => 88,
+    'y2k'              => 90,
   );
 
 %Bits = (
-    'all'              => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..44]
-    'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
-    'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
+    'all'              => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05", # [0..45]
+    'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
+    'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
     'closed'           => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
     'closure'          => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
-    'debugging'                => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
+    'debugging'                => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
     'deprecated'       => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
-    'digit'            => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
+    'digit'            => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
     'exec'             => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
     'exiting'          => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
     'glob'             => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
-    'inplace'          => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
-    'internal'         => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
-    'io'               => "\x00\x54\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
-    'malloc'           => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
-    'misc'             => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'newline'          => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
-    'numeric'          => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
-    'once'             => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
-    'overflow'         => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
-    'pack'             => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
-    'parenthesis'      => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
-    'pipe'             => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
-    'portable'         => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
-    'precedence'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
-    'printf'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
-    'prototype'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
-    'qw'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
-    'recursion'                => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
-    'redefine'         => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
-    'regexp'           => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
-    'reserved'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
-    'semicolon'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
-    'severe'           => "\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00", # [20..24]
-    'signal'           => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
-    'substr'           => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
-    'syntax'           => "\x00\x00\x00\x00\x00\x00\x40\x55\x55\x05\x00\x00", # [27..37]
-    'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
-    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
-    'unopened'         => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
-    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
-    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
-    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
-    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
-    'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
+    'inplace'          => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
+    'internal'         => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
+    'io'               => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
+    'layer'            => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'malloc'           => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
+    'misc'             => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'newline'          => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'numeric'          => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'once'             => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'overflow'         => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'pack'             => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'parenthesis'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
+    'pipe'             => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'portable'         => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'precedence'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
+    'printf'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
+    'prototype'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
+    'qw'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
+    'recursion'                => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'redefine'         => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'regexp'           => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
+    'reserved'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
+    'semicolon'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
+    'severe'           => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
+    'signal'           => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
+    'substr'           => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
+    'syntax'           => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
+    'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
+    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
+    'unopened'         => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
+    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
+    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
+    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
+    'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
   );
 
 %DeadBits = (
-    'all'              => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..44]
-    'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
-    'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
+    'all'              => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x0a", # [0..45]
+    'ambiguous'                => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
+    'bareword'         => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
     'closed'           => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
     'closure'          => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
-    'debugging'                => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
+    'debugging'                => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
     'deprecated'       => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
-    'digit'            => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
+    'digit'            => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
     'exec'             => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
     'exiting'          => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
     'glob'             => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
-    'inplace'          => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
-    'internal'         => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
-    'io'               => "\x00\xa8\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
-    'malloc'           => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
-    'misc'             => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
-    'newline'          => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
-    'numeric'          => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
-    'once'             => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
-    'overflow'         => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
-    'pack'             => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
-    'parenthesis'      => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
-    'pipe'             => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
-    'portable'         => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
-    'precedence'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
-    'printf'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
-    'prototype'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
-    'qw'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
-    'recursion'                => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
-    'redefine'         => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
-    'regexp'           => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
-    'reserved'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
-    'semicolon'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
-    'severe'           => "\x00\x00\x00\x00\x00\xaa\x02\x00\x00\x00\x00\x00", # [20..24]
-    'signal'           => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
-    'substr'           => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
-    'syntax'           => "\x00\x00\x00\x00\x00\x00\x80\xaa\xaa\x0a\x00\x00", # [27..37]
-    'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
-    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
-    'unopened'         => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
-    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
-    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
-    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
-    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
-    'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
+    'inplace'          => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
+    'internal'         => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
+    'io'               => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
+    'layer'            => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+    'malloc'           => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
+    'misc'             => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+    'newline'          => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+    'numeric'          => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+    'once'             => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+    'overflow'         => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+    'pack'             => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
+    'parenthesis'      => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
+    'pipe'             => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+    'portable'         => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
+    'precedence'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
+    'printf'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
+    'prototype'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
+    'qw'               => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
+    'recursion'                => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
+    'redefine'         => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
+    'regexp'           => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
+    'reserved'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
+    'semicolon'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
+    'severe'           => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
+    'signal'           => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
+    'substr'           => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
+    'syntax'           => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
+    'taint'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
+    'uninitialized'    => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
+    'unopened'         => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+    'unpack'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
+    'untie'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
+    'utf8'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
+    'void'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
+    'y2k'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
   );
 
 $NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
-$LAST_BIT = 90 ;
+$LAST_BIT = 92 ;
 $BYTES    = 12 ;
 
 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;

diff --git a/lib/warnings.t b/lib/warnings.t
index 009dee0..d952906 100644 (file)
--- a/lib/warnings.t
+++ b/lib/warnings.t
@@ -7,6 +7,8 @@ BEGIN {
     require Config; import Config;
 }
 
+use File::Path;
+
 $| = 1;
 
 my $Is_VMS     = $^O eq 'VMS';
@@ -58,6 +60,7 @@ for (@prgs){
      }
     my $switch = "";
     my @temps = () ;
+    my @temp_path = () ;
     if (s/^\s*-\w+//){
         $switch = $&;
         $switch =~ s/(-\S*[A-Z]\S*)/"$1"/ if $Is_VMS; # protect uc switches
@@ -73,6 +76,10 @@ for (@prgs){
            my $filename = shift @files ;
            my $code = shift @files ;
            push @temps, $filename ;
+           if ($filename =~ m#(.*)/#) {
+                mkpath($1);
+                push(@temp_path, $1);
+           }
            open F, ">$filename" or die "Cannot open $filename: $!\n" ;
            print F $code ;
            close F or die "Cannot close $filename: $!\n";
@@ -154,6 +161,8 @@ for (@prgs){
     print "ok ", ++$i, "\n";
     foreach (@temps)
        { unlink $_ if $_ }
+    foreach (@temp_path)
+       { rmtree $_ if -d $_ }
 }
 
 sub randomMatch

diff --git a/mg.c b/mg.c
index 62a1638..3e8e13d 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2348,7 +2348,7 @@ Perl_sighandler(int sig)
        flags |= 16;
 
     if (!PL_psig_ptr[sig]) {
-               Perl_warn(aTHX_ "Signal SIG%s received, but no signal handler set.\n",
+               PerlIO_printf(Perl_error_log, "Signal SIG%s received, but no signal handler set.\n",
                                 PL_sig_name[sig]);
                exit(sig);
        }

diff --git a/perlio.c b/perlio.c
index dd5f21c..fde7ea9 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -795,7 +795,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                     * seen as an invalid separator character.
                     */
                    char q = ((*s == '\'') ? '"' : '\'');
-                   Perl_warn(aTHX_
+                   if (ckWARN(WARN_LAYER))
+                       Perl_warner(aTHX_ packWARN(WARN_LAYER),
                              "perlio: invalid separator character %c%c%c in layer specification list %s",
                              q, *s, q, s);
                    return -1;
@@ -830,7 +831,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                             */
                        case '\0':
                            e--;
-                           Perl_warn(aTHX_
+                           if (ckWARN(WARN_LAYER))
+                               Perl_warner(aTHX_ packWARN(WARN_LAYER),
                                      "perlio: argument list not closed for layer \"%.*s\"",
                                      (int) (e - s), s);
                            return -1;
@@ -843,6 +845,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                    }
                }
                if (e > s) {
+                   bool warn_layer = ckWARN(WARN_LAYER);
                    PerlIO_funcs *layer =
                        PerlIO_find_layer(aTHX_ s, llen, 1);
                    if (layer) {
@@ -852,7 +855,8 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names)
                                         &PL_sv_undef);
                    }
                    else {
-                       Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",
+                       if (warn_layer)
+                           Perl_warner(aTHX_ packWARN(WARN_LAYER), "perlio: unknown layer \"%.*s\"",
                                  (int) llen, s);
                        return -1;
                    }
@@ -3581,11 +3585,13 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
         }
        chk -= cnt;
 
+#ifdef USE_ATTRIBUTES_FOR_PERLIO
        if (ptr != chk ) {
-           Perl_warn(aTHX_ "ptr wrong %p != %p fl=%08" UVxf
+           Perl_croak(aTHX_ "ptr wrong %p != %p fl=%08" UVxf
                       " nl=%p e=%p for %d", ptr, chk, flags, c->nl,
                       b->end, cnt);
        }
+#endif
     }
     if (c->nl) {
        if (ptr > c->nl) {

diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod
index 2549256..fd4b025 100644 (file)
--- a/pod/perllexwarn.pod
+++ b/pod/perllexwarn.pod
@@ -221,6 +221,8 @@ The current hierarchy is:
        |                |
        |                +- exec
        |                |
+       |                +- layer
+       |                |
        |                +- newline
        |                |
        |                +- pipe

diff --git a/t/lib/warnings/perlio b/t/lib/warnings/perlio
index 18c0dfa..5848668 100644 (file)
--- a/t/lib/warnings/perlio
+++ b/t/lib/warnings/perlio
@@ -7,4 +7,49 @@
     Setting ptr %p > end+1 %p
     Setting cnt to %d, ptr implies %d
 
+
+perlio: invalid separator character %c%c%c in layer specification list %s
+
+    open(F, ">:-aa", "bb")
+
+
+perlio: argument list not closed for layer \"%.*s\""
+
+    open(F, ">:aa(", "bb")
+
+perlio: unknown layer \"%.*s\"
+
+    # PerlIO/xyz.pm has 1;
+    open(F, ">xyz", "bb")
+
 __END__
+
+# perlio [PerlIO_parse_layers]
+no warnings 'layer';
+open(F, ">:-aa", "bb");
+use warnings 'layer';
+open(F, ">:-aa", "bb");
+EXPECT
+perlio: invalid separator character '-' in layer specification list -aa at - line 6.
+########
+
+# perlio [PerlIO_parse_layers]
+no warnings 'layer';
+open(F, ">:aa(", "bb");
+use warnings 'layer';
+open(F, ">:aa(", "bb");
+EXPECT
+perlio: argument list not closed for layer "aa(" at - line 6.
+########
+
+--FILE-- PerlIO/xyz.pm
+1;
+--FILE--
+# perlio [PerlIO_parse_layers]
+no warnings 'layer';
+open(F, ">:xyz", "bb");
+#use warnings 'layer';
+use warnings ;
+open(F, ">:xyz", "bb");
+EXPECT
+perlio: unknown layer "xyz".

diff --git a/warnings.h b/warnings.h
index 0649c7e..3da705e 100644 (file)
--- a/warnings.h
+++ b/warnings.h
@@ -30,48 +30,49 @@
 #define WARN_IO                        5
 #define WARN_CLOSED            6
 #define WARN_EXEC              7
-#define WARN_NEWLINE           8
-#define WARN_PIPE              9
-#define WARN_UNOPENED          10
-#define WARN_MISC              11
-#define WARN_NUMERIC           12
-#define WARN_ONCE              13
-#define WARN_OVERFLOW          14
-#define WARN_PACK              15
-#define WARN_PORTABLE          16
-#define WARN_RECURSION         17
-#define WARN_REDEFINE          18
-#define WARN_REGEXP            19
-#define WARN_SEVERE            20
-#define WARN_DEBUGGING         21
-#define WARN_INPLACE           22
-#define WARN_INTERNAL          23
-#define WARN_MALLOC            24
-#define WARN_SIGNAL            25
-#define WARN_SUBSTR            26
-#define WARN_SYNTAX            27
-#define WARN_AMBIGUOUS         28
-#define WARN_BAREWORD          29
-#define WARN_DIGIT             30
-#define WARN_PARENTHESIS       31
-#define WARN_PRECEDENCE                32
-#define WARN_PRINTF            33
-#define WARN_PROTOTYPE         34
-#define WARN_QW                        35
-#define WARN_RESERVED          36
-#define WARN_SEMICOLON         37
-#define WARN_TAINT             38
-#define WARN_UNINITIALIZED     39
-#define WARN_UNPACK            40
-#define WARN_UNTIE             41
-#define WARN_UTF8              42
-#define WARN_VOID              43
-#define WARN_Y2K               44
+#define WARN_LAYER             8
+#define WARN_NEWLINE           9
+#define WARN_PIPE              10
+#define WARN_UNOPENED          11
+#define WARN_MISC              12
+#define WARN_NUMERIC           13
+#define WARN_ONCE              14
+#define WARN_OVERFLOW          15
+#define WARN_PACK              16
+#define WARN_PORTABLE          17
+#define WARN_RECURSION         18
+#define WARN_REDEFINE          19
+#define WARN_REGEXP            20
+#define WARN_SEVERE            21
+#define WARN_DEBUGGING         22
+#define WARN_INPLACE           23
+#define WARN_INTERNAL          24
+#define WARN_MALLOC            25
+#define WARN_SIGNAL            26
+#define WARN_SUBSTR            27
+#define WARN_SYNTAX            28
+#define WARN_AMBIGUOUS         29
+#define WARN_BAREWORD          30
+#define WARN_DIGIT             31
+#define WARN_PARENTHESIS       32
+#define WARN_PRECEDENCE                33
+#define WARN_PRINTF            34
+#define WARN_PROTOTYPE         35
+#define WARN_QW                        36
+#define WARN_RESERVED          37
+#define WARN_SEMICOLON         38
+#define WARN_TAINT             39
+#define WARN_UNINITIALIZED     40
+#define WARN_UNPACK            41
+#define WARN_UNTIE             42
+#define WARN_UTF8              43
+#define WARN_VOID              44
+#define WARN_Y2K               45
 
 #define WARNsize               12
 #define WARN_ALLstring         "\125\125\125\125\125\125\125\125\125\125\125\125"
 #define WARN_NONEstring                "\0\0\0\0\0\0\0\0\0\0\0\0"
-#define WARN_TAINTstring       "\0\0\0\0\0\0\0\0\0\20\0\0"
+#define WARN_TAINTstring       "\0\0\0\0\0\0\0\0\0\100\0\0"
 
 #define isLEXWARN_on   (PL_curcop->cop_warnings != pWARN_STD)
 #define isLEXWARN_off  (PL_curcop->cop_warnings == pWARN_STD)

diff --git a/warnings.pl b/warnings.pl
index 9149f69..caa4954 100644 (file)
--- a/warnings.pl
+++ b/warnings.pl
@@ -19,6 +19,7 @@ my $tree = {
                                        'closed'        => DEFAULT_OFF,
                                        'newline'       => DEFAULT_OFF,
                                        'exec'          => DEFAULT_OFF,
+                                       'layer'         => DEFAULT_OFF,
                           },
                'syntax'        => {    'ambiguous'     => DEFAULT_OFF,
                                'semicolon'     => DEFAULT_OFF,