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