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