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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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 (file)
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);
+