t/basic.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::Exception;
   5 use Test::More;
   6 use Test::Warn;
   7
   8 {
   9     throws_ok {
  10         eval 'package Foo; use Package::DeprecationManager;';
  11         die $@ if $@;
  12     }
  13     qr/^\QYou must provide a hash reference -deprecations parameter when importing Package::DeprecationManager/,
  14         'must provide a set of deprecations when using Package::DeprecationManager';
  15 }
  16
  17 {
  18     package Foo;
  19
  20     use Package::DeprecationManager -deprecations => {
  21         'Foo::foo'  => '0.02',
  22         'Foo::bar'  => '0.03',
  23         'Foo::baz'  => '1.21',
  24         'not a sub' => '1.23',
  25     };
  26
  27     sub foo {
  28         deprecated('foo is deprecated');
  29     }
  30
  31     sub bar {
  32         deprecated('bar is deprecated');
  33     }
  34
  35     sub baz {
  36         deprecated();
  37     }
  38
  39     sub quux {
  40         if ( $_[0] > 5 ) {
  41             deprecated(
  42                 message => 'quux > 5 has been deprecated',
  43                 feature => 'not a sub',
  44             );
  45         }
  46     }
  47
  48     sub varies {
  49         deprecated("The varies sub varies: $_[0]");
  50     }
  51
  52 }
  53
  54 {
  55     package Bar;
  56
  57     Foo->import();
  58
  59     ::warning_is{ Foo::foo() }
  60         { carped => 'foo is deprecated' },
  61         'deprecation warning for foo';
  62
  63     ::warning_is{ Foo::bar() }
  64         { carped => 'bar is deprecated' },
  65         'deprecation warning for bar';
  66
  67     ::warning_is{ Foo::baz() }
  68         { carped => 'Foo::baz has been deprecated since version 1.21' },
  69         'deprecation warning for baz, and message is generated by Package::DeprecationManager';
  70
  71     ::warning_is{ Foo::foo() } q{}, 'no warning on second call to foo';
  72
  73     ::warning_is{ Foo::bar() } q{}, 'no warning on second call to bar';
  74
  75     ::warning_is{ Foo::baz() } q{}, 'no warning on second call to baz';
  76
  77     ::warning_is{ Foo::varies(1) }
  78         { carped => "The varies sub varies: 1" },
  79         'warning for varies sub';
  80
  81     ::warning_is{ Foo::varies(2) }
  82         { carped => "The varies sub varies: 2" },
  83         'warning for varies sub with different error';
  84
  85     ::warning_is{ Foo::varies(1) }
  86         q{},
  87         'no warning for varies sub with same message as first call';
  88 }
  89
  90 {
  91     package Baz;
  92
  93     Foo->import( -api_version => '0.01' );
  94
  95     ::warning_is{ Foo::foo() }
  96         q{},
  97         'no warning for foo with api_version = 0.01';
  98
  99     ::warning_is{ Foo::bar() }
 100         q{},
 101         'no warning for bar with api_version = 0.01';
 102
 103     ::warning_is{ Foo::baz() }
 104         q{},
 105         'no warning for baz with api_version = 0.01';
 106 }
 107
 108 {
 109     package Quux;
 110
 111     Foo->import( -api_version => '1.17' );
 112
 113     ::warning_is{ Foo::foo() }
 114         { carped => 'foo is deprecated' },
 115         'deprecation warning for foo with api_version = 1.17';
 116
 117     ::warning_is{ Foo::bar() }
 118         { carped => 'bar is deprecated' },
 119         'deprecation warning for bar with api_version = 1.17';
 120
 121     ::warning_is{ Foo::baz() }
 122         q{},
 123         'no warning for baz with api_version = 1.17';
 124 }
 125
 126 {
 127     package Another;
 128
 129     Foo->import();
 130
 131     ::warning_is{ Foo::quux(1) }
 132         q{},
 133         'no warning for quux(1)';
 134
 135     ::warning_is{ Foo::quux(10) }
 136         { carped => 'quux > 5 has been deprecated' },
 137         'got a warning for quux(10)';
 138 }
 139
 140
 141 {
 142     package Dep;
 143
 144     use Package::DeprecationManager -deprecations => {
 145         'foo' => '1.00',
 146         },
 147         -ignore => [ 'My::Foo', 'My::Bar' ];
 148
 149     sub foo {
 150         deprecated('foo is deprecated');
 151     }
 152 }
 153
 154 {
 155     package My::Foo;
 156
 157     sub foo { Dep::foo() }
 158 }
 159
 160 {
 161     package My::Bar;
 162
 163     sub foo { My::Foo::foo() }
 164 }
 165
 166 {
 167     package My::Baz;
 168
 169     ::warning_like{ My::Bar::foo() }
 170         qr/^foo is deprecated at t.basic\.t line \d+/,
 171         'deprecation warning for call to My::Bar::foo()';
 172 }
 173
 174 {
 175     package My::Baz;
 176
 177     Dep->import( -api_version => '0.8' );
 178
 179     ::warning_is{ My::Bar::foo() }
 180         q{},
 181         'no wanrning when calling My::Bar::foo()';
 182 }
 183
 184 done_testing();