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

2 files changed, 34 insertions, 13 deletions

diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs
index d1d4e644f0..af5f5ea00f 100644
--- 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 a2201e08c6..89a1e13236 100644
--- 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;