From: Robin Barker <Robin.Barker@npl.co.uk>
Date: Wed, 25 Feb 2009 08:41:52 +0000 (+0100)
Subject: test script for deprecate.pm
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c0f08d2c3ac00e3462618e9b7575fa42baf6064b;p=p5sagit%2Fp5-mst-13.2.git

test script for deprecate.pm

First pass at tests for deprecate.pm.

Had to modify the module to provide an interface for testing - need to
provide fake install directories, but deprecated reads from
%Config::Config, which is read only.
---

diff --git a/MANIFEST b/MANIFEST
index cd3fd06..4aa99c4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3809,6 +3809,9 @@ t/lib/compress/zlib-generic.pl	Compress::Zlib
 t/lib/contains_bad_pod.xr	Pod-Parser test file
 t/lib/contains_pod.xr		Pod-Parser test file
 t/lib/cygwin.t			Builtin cygwin function tests
+t/lib/deprecate.t		Test deprecate.pm
+t/lib/deprecate/Deprecated.pm	Deprecated module to test deprecate.pm
+t/lib/deprecate/Optionally.pm	Optionally deprecated module to test deprecate.pm
 t/lib/Devel/switchd.pm		Module for t/run/switchd.t
 t/lib/Dev/Null.pm		Test::More test module
 t/lib/dprof/test1_t		Perl code profiler tests
diff --git a/lib/deprecate.pm b/lib/deprecate.pm
index 068c1b9..e33d8c5 100644
--- a/lib/deprecate.pm
+++ b/lib/deprecate.pm
@@ -1,12 +1,12 @@
-#!perl -w
-use strict;
-
 package deprecate;
-use Config;
-use Carp;
+use strict;
 use warnings;
 our $VERSION = 0.01;
 
+# our %Config can ignore %Config::Config, e.g. for testing
+our %Config;
+unless (%Config) { require Config; *Config = \%Config::Config; }
+
 sub import {
     my ($package, $file, $line) = caller;
     my $expect_leaf = "$package.pm";
@@ -42,7 +42,7 @@ EOM
             	&& (vec($callers_bitmask, $warnings::Offsets{deprecated}, 1)
 		    || vec($callers_bitmask, $warnings::Offsets{all}, 1))) {
 		warn <<"EOM";
-$package will be removed from the Perl core distribution in the next major release. Please install it from CPAN. It is being used at $call_file line $call_line
+$package will be removed from the Perl core distribution in the next major release. Please install it from CPAN. It is being used at $call_file, line $call_line.
 EOM
 	    }
 	    return;
diff --git a/t/lib/deprecate.t b/t/lib/deprecate.t
new file mode 100644
index 0000000..1b66129
--- /dev/null
+++ b/t/lib/deprecate.t
@@ -0,0 +1,79 @@
+use strict;
+
+BEGIN {
+	chdir 't' if -d 't';
+	chdir 'lib/deprecate' or die "Can't see lib/deprecate";
+	@INC = qw(../../../lib
+		lib/perl/arch
+		lib/perl
+		lib/site/arch
+		lib/site
+	);
+}
+use File::Copy ();
+use File::Path ();
+use Test::More tests => 10;
+
+my %libdir = (
+	privlibexp	=> 'lib/perl',
+	sitelibexp	=> 'lib/site',
+	archlibexp	=> 'lib/perl/arch',
+	sitearchexp	=> 'lib/site/arch',
+);
+
+mkdir for 'lib', sort values %libdir;
+
+our %tests = (
+	privlibexp	=> 1,
+	sitelibexp	=> 0,
+	archlibexp	=> 1,
+	sitearchexp	=> 0,
+);
+
+local %deprecate::Config = (%libdir);
+
+for my $lib (sort keys %tests) {
+    my $dir = $libdir{$lib};
+    File::Copy::copy 'Deprecated.pm', "$dir/Deprecated.pm";
+
+    my $warn;
+    {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
+        use warnings qw(deprecated);
+#line 1001
+	require Deprecated;
+#line
+    }
+    if( $tests{$lib} ) {
+        like($warn, qr/^Deprecated\s+will\s+be\s+removed\b/, "$lib - message");
+        like($warn, qr/$0,?\s+line\s+1001\.?\n*$/, "$lib - location");
+    }
+    else {
+	ok( !$warn, "$lib - no message" );
+    }
+
+    delete $INC{'Deprecated.pm'};
+    unlink "$dir/Deprecated.pm";
+}
+
+for my $lib (sort keys %tests) {
+    my $dir = $libdir{$lib};
+    mkdir "$dir/Optionally";
+    File::Copy::copy 'Optionally.pm', "$dir/Optionally/Deprecated.pm";
+
+    my $warn;
+    {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
+        use warnings qw(deprecated);
+	require Optionally::Deprecated;
+    }
+    if( $tests{$lib} ) {
+        like($warn, qr/^Optionally::Deprecated\s+will\s+be\s+removed\b/,
+		"$lib - use if - message");
+    }
+    else {
+	ok( !$warn, "$lib - use if - no message" );
+    }
+
+    delete $INC{'Optionally/Deprecated.pm'};
+    unlink "$dir/Optionally/Deprecated.pm";
+}
+# END { File::Path::rmtree 'lib' }
diff --git a/t/lib/deprecate/Deprecated.pm b/t/lib/deprecate/Deprecated.pm
new file mode 100644
index 0000000..5eb1220
--- /dev/null
+++ b/t/lib/deprecate/Deprecated.pm
@@ -0,0 +1,7 @@
+package Deprecated;
+use strict;
+
+use deprecate;
+
+q(Harmless);
+
diff --git a/t/lib/deprecate/Optionally.pm b/t/lib/deprecate/Optionally.pm
new file mode 100644
index 0000000..1e24542
--- /dev/null
+++ b/t/lib/deprecate/Optionally.pm
@@ -0,0 +1,7 @@
+package Optionally::Deprecated;
+use strict;
+
+use if $] >=  5.011, 'deprecate';
+
+q(Mostly harmless);
+