1b39c5158Smillert#!perl -w 2b39c5158Smillertuse strict; 3b39c5158Smillert 4b39c5158SmillertBEGIN { 5*b8851fccSafresh1 chdir 't' if -d 't'; 6b39c5158Smillert require './test.pl'; 7b39c5158Smillert} 8b39c5158Smillertuse File::Copy (); 9b39c5158Smillertuse File::Path (); 10b39c5158Smillertuse File::Spec (); 11b39c5158Smillertplan(tests => 10); 12b39c5158Smillert 13b39c5158Smillertmy $test_dir = File::Spec->catdir(qw(lib deprecate)); 14b39c5158Smillertchdir $test_dir or die "Can't chdir $test_dir"; 15b39c5158Smillert@INC = ( File::Spec->catdir( (File::Spec->updir)x3, qw(lib)) ); 16b39c5158Smillert 17b39c5158Smillertmy %libdir = ( 18b39c5158Smillert privlibexp => File::Spec->catdir(qw(lib perl)), 19b39c5158Smillert sitelibexp => File::Spec->catdir(qw(lib site)), 20b39c5158Smillert archlibexp => File::Spec->catdir(qw(lib perl arch)), 21b39c5158Smillert sitearchexp => File::Spec->catdir(qw(lib site arch)), 22b39c5158Smillert); 23b39c5158Smillert 24b39c5158SmillertFile::Path::make_path(values %libdir); 25b39c5158Smillert 26b39c5158Smillertpush @INC, @libdir{qw(archlibexp privlibexp sitearchexp sitelibexp)}; 27b39c5158Smillert 28b39c5158Smillertour %tests = ( 29b39c5158Smillert privlibexp => 1, 30b39c5158Smillert sitelibexp => 0, 31b39c5158Smillert archlibexp => 1, 32b39c5158Smillert sitearchexp => 0, 33b39c5158Smillert); 34b39c5158Smillert 35b39c5158Smillertno warnings 'once'; 36b39c5158Smillertlocal %deprecate::Config = (%libdir); 37b39c5158Smillert 38b39c5158Smillertmy $module = 'Deprecated.pm'; 39b39c5158Smillertfor my $lib (sort keys %tests) { 40b39c5158Smillert my $dir = $libdir{$lib}; 41b39c5158Smillert my $pm = File::Spec->catfile($dir, $module); 42b39c5158Smillert File::Copy::copy($module, $pm); 43b39c5158Smillert 44b39c5158Smillert my $warn = ''; 45b39c5158Smillert { local $SIG{__WARN__} = sub { $warn .= $_[0]; }; 46b39c5158Smillert use warnings qw(deprecated); 47b39c5158Smillert#line 1001 48b39c5158Smillert require Deprecated; 49b39c5158Smillert#line 50b39c5158Smillert } 51b39c5158Smillert if( $tests{$lib} ) { 52b39c5158Smillert like($warn, qr/^Deprecated\s+will\s+be\s+removed\b/, "$lib - message"); 53b39c5158Smillert my $me = quotemeta($0); 54b39c5158Smillert like($warn, qr/$me,?\s+line\s+1001\.?\n*$/, "$lib - location"); 55b39c5158Smillert } 56b39c5158Smillert else { 57b39c5158Smillert ok( !$warn, "$lib - no message" ); 58b39c5158Smillert } 59b39c5158Smillert 60b39c5158Smillert delete $INC{$module}; 61898184e3Ssthen unlink_all $pm; 62b39c5158Smillert} 63b39c5158Smillert 64b39c5158Smillertmy $sub_dir = 'Optionally'; 65b39c5158Smillertmy $opt_mod = $sub_dir .'.pm'; 66b39c5158Smillertfor my $lib (sort keys %tests) { 67b39c5158Smillert my $dir = File::Spec->catdir($libdir{$lib}, $sub_dir); 68b39c5158Smillert File::Path::make_path($dir); 69b39c5158Smillert 70b39c5158Smillert my $pm = File::Spec->catfile($dir, $module); 71b39c5158Smillert File::Copy::copy($opt_mod, $pm); 72b39c5158Smillert 73b39c5158Smillert my $warn = ''; 74b39c5158Smillert { local $SIG{__WARN__} = sub { $warn .= $_[0]; }; 75b39c5158Smillert use warnings qw(deprecated); 76b39c5158Smillert require Optionally::Deprecated; 77b39c5158Smillert } 78b39c5158Smillert if( $tests{$lib} ) { 79b39c5158Smillert like($warn, qr/^Optionally::Deprecated\s+will\s+be\s+removed\b/, 80b39c5158Smillert "$lib - use if - message"); 81b39c5158Smillert } 82b39c5158Smillert else { 83b39c5158Smillert ok( !$warn, "$lib - use if - no message" ); 84b39c5158Smillert } 85b39c5158Smillert 86b39c5158Smillert delete $INC{"$sub_dir/$module"}; 87898184e3Ssthen unlink_all $pm; 88b39c5158Smillert} 89b39c5158Smillert 90b39c5158SmillertEND { File::Path::remove_tree('lib') } 91