Commit | Line | Data |
---|---|---|
eaa79d3d | 1 | #!perl -w |
c0f08d2c RB |
2 | use strict; |
3 | ||
4 | BEGIN { | |
b5efbd1f | 5 | chdir 't' if -d 't'; |
eaa79d3d | 6 | require './test.pl'; |
c0f08d2c RB |
7 | } |
8 | use File::Copy (); | |
9 | use File::Path (); | |
6b913759 | 10 | use File::Spec (); |
eaa79d3d | 11 | plan(tests => 10); |
c0f08d2c | 12 | |
6b913759 RB |
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 | ||
c0f08d2c | 17 | my %libdir = ( |
6b913759 RB |
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)), | |
c0f08d2c RB |
22 | ); |
23 | ||
6b913759 RB |
24 | File::Path::make_path(values %libdir); |
25 | ||
26 | push @INC, @libdir{qw(archlibexp privlibexp sitearchexp sitelibexp)}; | |
c0f08d2c RB |
27 | |
28 | our %tests = ( | |
29 | privlibexp => 1, | |
30 | sitelibexp => 0, | |
31 | archlibexp => 1, | |
32 | sitearchexp => 0, | |
33 | ); | |
34 | ||
eaa79d3d | 35 | no warnings 'once'; |
c0f08d2c RB |
36 | local %deprecate::Config = (%libdir); |
37 | ||
6b913759 | 38 | my $module = 'Deprecated.pm'; |
c0f08d2c RB |
39 | for my $lib (sort keys %tests) { |
40 | my $dir = $libdir{$lib}; | |
6b913759 RB |
41 | my $pm = File::Spec->catfile($dir, $module); |
42 | File::Copy::copy($module, $pm); | |
c0f08d2c | 43 | |
6b913759 | 44 | my $warn = ''; |
c0f08d2c RB |
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"); | |
096fcbb8 CB |
53 | my $me = quotemeta($0); |
54 | like($warn, qr/$me,?\s+line\s+1001\.?\n*$/, "$lib - location"); | |
c0f08d2c RB |
55 | } |
56 | else { | |
57 | ok( !$warn, "$lib - no message" ); | |
58 | } | |
59 | ||
6b913759 | 60 | delete $INC{$module}; |
ab679d05 | 61 | unlink_all $pm; |
c0f08d2c RB |
62 | } |
63 | ||
6b913759 RB |
64 | my $sub_dir = 'Optionally'; |
65 | my $opt_mod = $sub_dir .'.pm'; | |
c0f08d2c | 66 | for my $lib (sort keys %tests) { |
6b913759 RB |
67 | my $dir = File::Spec->catdir($libdir{$lib}, $sub_dir); |
68 | File::Path::make_path($dir); | |
c0f08d2c | 69 | |
6b913759 RB |
70 | my $pm = File::Spec->catfile($dir, $module); |
71 | File::Copy::copy($opt_mod, $pm); | |
72 | ||
73 | my $warn = ''; | |
c0f08d2c RB |
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 | ||
6b913759 | 86 | delete $INC{"$sub_dir/$module"}; |
ab679d05 | 87 | unlink_all $pm; |
c0f08d2c | 88 | } |
6b913759 RB |
89 | |
90 | END { File::Path::remove_tree('lib') } |