From: Paul Marquess <paul.marquess@btinternet.com>
Date: Mon, 28 Oct 2002 12:53:52 +0000 (+0000)
Subject: RE: [PATCH] Warning on pararameterless 'use IO' and doc update
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b8370f2a62ce28c9808787355d168ac28a1aaa1c;p=p5sagit%2Fp5-mst-13.2.git

RE: [PATCH] Warning on pararameterless 'use IO' and doc update
From: "Paul Marquess" <Paul.Marquess@btinternet.com>
Message-ID: <AIEAJICLCBDNAAOLLOKLAEOEFLAA.Paul.Marquess@btinternet.com>

p4raw-id: //depot/perl@18071
---

diff --git a/ext/IO/IO.pm b/ext/IO/IO.pm
index 6a4a7ff..287671e 100644
--- a/ext/IO/IO.pm
+++ b/ext/IO/IO.pm
@@ -4,17 +4,18 @@ package IO;
 
 use XSLoader ();
 use Carp;
+use strict;
+use warnings;
 
-$VERSION = "1.20";
+our $VERSION = "1.20";
 XSLoader::load 'IO', $VERSION;
 
 sub import {
     shift;
-    if (@_ == 0) {
-	require warnings;
-	warnings::warn('deprecated', qq{parameterless "use IO" deprecated})
-		if warnings::enabled('deprecated');
-    }
+
+    warnings::warnif('deprecated', qq{parameterless "use IO" deprecated})
+        if @_ == 0 ;
+    
     my @l = @_ ? @_ : qw(Handle Seekable File Pipe Socket Dir);
 
     eval join("", map { "require IO::" . (/(\w+)/)[0] . ";\n" } @l)
diff --git a/ext/IO/lib/IO/t/IO.t b/ext/IO/lib/IO/t/IO.t
index d3f87a1..89226af 100644
--- a/ext/IO/lib/IO/t/IO.t
+++ b/ext/IO/lib/IO/t/IO.t
@@ -9,7 +9,7 @@ BEGIN
 use strict;
 use File::Path;
 use File::Spec;
-use Test::More tests => 13;
+use Test::More tests => 18;
 
 {
 	local $INC{'XSLoader.pm'} = 1;
@@ -30,7 +30,47 @@ use Test::More tests => 13;
 my @default = map { "IO/$_.pm" } qw( Handle Seekable File Pipe Socket Dir );
 delete @INC{ @default };
 
-IO->import();
+my $warn = '' ;
+local $SIG{__WARN__} = sub { $warn = "@_" } ;
+
+{
+    no warnings ;
+    IO->import();
+    is( $warn, '', "... import default, should not warn");
+    $warn = '' ;
+}
+
+{
+    local $^W = 0;
+    IO->import();
+    is( $warn, '', "... import default, should not warn");
+    $warn = '' ;
+}
+
+{
+    local $^W = 1;
+    IO->import();
+    like( $warn, qr/^parameterless "use IO" deprecated at/, 
+              "... import default, should warn");
+    $warn = '' ;
+}
+
+{
+    use warnings 'deprecated' ;
+    IO->import(); 
+    like( $warn, qr/^parameterless "use IO" deprecated at/, 
+              "... import default, should warn");
+    $warn = '' ;
+}
+
+{
+    use warnings ;
+    IO->import();
+    like( $warn, qr/^parameterless "use IO" deprecated at/, 
+              "... import default, should warn");
+    $warn = '' ;
+}
+
 foreach my $default (@default)
 {
 	ok( exists $INC{ $default }, "... import should default load $default" );