t/lib/deprecate.t

   1 #!perl -w
   2 use strict;
   3
   4 BEGIN {
   5     require './test.pl';
   6 }
   7 use File::Copy ();
   8 use File::Path ();
   9 use File::Spec ();
  10 plan(tests => 10);
  11
  12 my $test_dir = File::Spec->catdir(qw(lib deprecate));
  13 chdir $test_dir or die "Can't chdir $test_dir";
  14 @INC = ( File::Spec->catdir( (File::Spec->updir)x3, qw(lib)) );
  15
  16 my %libdir = (
  17         privlibexp      => File::Spec->catdir(qw(lib perl)),
  18         sitelibexp      => File::Spec->catdir(qw(lib site)),
  19         archlibexp      => File::Spec->catdir(qw(lib perl arch)),
  20         sitearchexp     => File::Spec->catdir(qw(lib site arch)),
  21 );
  22
  23 File::Path::make_path(values %libdir);
  24
  25 push @INC, @libdir{qw(archlibexp privlibexp sitearchexp sitelibexp)};
  26
  27 our %tests = (
  28         privlibexp      => 1,
  29         sitelibexp      => 0,
  30         archlibexp      => 1,
  31         sitearchexp     => 0,
  32 );
  33
  34 no warnings 'once';
  35 local %deprecate::Config = (%libdir);
  36
  37 my $module = 'Deprecated.pm';
  38 for my $lib (sort keys %tests) {
  39     my $dir = $libdir{$lib};
  40     my $pm = File::Spec->catfile($dir, $module);
  41     File::Copy::copy($module, $pm);
  42
  43     my $warn = '';
  44     {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
  45         use warnings qw(deprecated);
  46 #line 1001
  47         require Deprecated;
  48 #line
  49     }
  50     if( $tests{$lib} ) {
  51         like($warn, qr/^Deprecated\s+will\s+be\s+removed\b/, "$lib - message");
  52         my $me = quotemeta($0);
  53         like($warn, qr/$me,?\s+line\s+1001\.?\n*$/, "$lib - location");
  54     }
  55     else {
  56         ok( !$warn, "$lib - no message" );
  57     }
  58
  59     delete $INC{$module};
  60     unlink_all $pm;
  61 }
  62
  63 my $sub_dir = 'Optionally';
  64 my $opt_mod = $sub_dir .'.pm';
  65 for my $lib (sort keys %tests) {
  66     my $dir = File::Spec->catdir($libdir{$lib}, $sub_dir);
  67     File::Path::make_path($dir);
  68
  69     my $pm = File::Spec->catfile($dir, $module);
  70     File::Copy::copy($opt_mod, $pm);
  71
  72     my $warn = '';
  73     {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
  74         use warnings qw(deprecated);
  75         require Optionally::Deprecated;
  76     }
  77     if( $tests{$lib} ) {
  78         like($warn, qr/^Optionally::Deprecated\s+will\s+be\s+removed\b/,
  79                 "$lib - use if - message");
  80     }
  81     else {
  82         ok( !$warn, "$lib - use if - no message" );
  83     }
  84
  85     delete $INC{"$sub_dir/$module"};
  86     unlink_all $pm;
  87 }
  88
  89 END { File::Path::remove_tree('lib') }