t/lib/deprecate.t

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