| 1 | use strict; |
| 2 | |
| 3 | BEGIN { |
| 4 | chdir 't' if -d 't'; |
| 5 | @INC = qw(../lib); |
| 6 | } |
| 7 | use File::Copy (); |
| 8 | use File::Path (); |
| 9 | use File::Spec (); |
| 10 | use Test::More tests => 10; |
| 11 | |
| 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 | |
| 16 | my %libdir = ( |
| 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)), |
| 21 | ); |
| 22 | |
| 23 | File::Path::make_path(values %libdir); |
| 24 | |
| 25 | push @INC, @libdir{qw(archlibexp privlibexp sitearchexp sitelibexp)}; |
| 26 | |
| 27 | our %tests = ( |
| 28 | privlibexp => 1, |
| 29 | sitelibexp => 0, |
| 30 | archlibexp => 1, |
| 31 | sitearchexp => 0, |
| 32 | ); |
| 33 | |
| 34 | local %deprecate::Config = (%libdir); |
| 35 | |
| 36 | my $module = 'Deprecated.pm'; |
| 37 | for my $lib (sort keys %tests) { |
| 38 | my $dir = $libdir{$lib}; |
| 39 | my $pm = File::Spec->catfile($dir, $module); |
| 40 | File::Copy::copy($module, $pm); |
| 41 | |
| 42 | my $warn = ''; |
| 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"); |
| 51 | my $me = quotemeta($0); |
| 52 | like($warn, qr/$me,?\s+line\s+1001\.?\n*$/, "$lib - location"); |
| 53 | } |
| 54 | else { |
| 55 | ok( !$warn, "$lib - no message" ); |
| 56 | } |
| 57 | |
| 58 | delete $INC{$module}; |
| 59 | unlink $pm; |
| 60 | } |
| 61 | |
| 62 | my $sub_dir = 'Optionally'; |
| 63 | my $opt_mod = $sub_dir .'.pm'; |
| 64 | for my $lib (sort keys %tests) { |
| 65 | my $dir = File::Spec->catdir($libdir{$lib}, $sub_dir); |
| 66 | File::Path::make_path($dir); |
| 67 | |
| 68 | my $pm = File::Spec->catfile($dir, $module); |
| 69 | File::Copy::copy($opt_mod, $pm); |
| 70 | |
| 71 | my $warn = ''; |
| 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 | |
| 84 | delete $INC{"$sub_dir/$module"}; |
| 85 | unlink $pm; |
| 86 | } |
| 87 | |
| 88 | END { File::Path::remove_tree('lib') } |