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