Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
Devel	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
charnames	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
croak	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
deprecate	[ DIR ]	drwxr-xr-x	2016-10-10 18:14
feature	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
locale	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
strict	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
subs	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
warnings	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
1_compile.t	1.64 KB	-r--r--r--	2014-12-27 11:49
Cname.pm	934 B	-r--r--r--	2014-12-27 11:49
Count.pm	107 B	-r--r--r--	2014-12-27 11:49
Sans_mypragma.pm	72 B	-r--r--r--	2014-12-27 11:49
common.pl	1.37 KB	-r--r--r--	2014-12-27 11:49
commonsense.t	583 B	-r--r--r--	2014-12-27 11:49
compmod.pl	274 B	-r--r--r--	2014-12-27 11:49
croak.t	126 B	-r--r--r--	2014-12-27 11:49
cygwin.t	2.2 KB	-r--r--r--	2014-12-27 11:49
dbmt_common.pl	11.85 KB	-r--r--r--	2014-12-27 11:49
deprecate.t	2.11 KB	-r--r--r--	2014-12-27 11:49
h2ph.h	3.98 KB	-r--r--r--	2014-12-27 11:49
h2ph.pht	3.96 KB	-r--r--r--	2014-12-27 11:49
mypragma.pm	596 B	-r--r--r--	2014-12-27 11:49
mypragma.t	1.32 KB	-r--r--r--	2014-12-27 11:49
no_load.t	637 B	-r--r--r--	2014-12-27 11:49
overload_fallback.t	388 B	-r--r--r--	2014-12-27 11:49
overload_nomethod.t	362 B	-r--r--r--	2014-12-27 11:49
proxy_constant_subs.t	873 B	-r--r--r--	2014-12-27 11:49
test_require.pm	114 B	-r--r--r--	2014-12-27 11:49
test_use.pm	126 B	-r--r--r--	2014-12-27 11:49
test_use_14937.pm	3 B	-r--r--r--	2014-12-27 11:49
universal.t	1.89 KB	-r--r--r--	2014-12-27 11:49

Rename

#!perl -w
use strict;

BEGIN {
    require './test.pl';
}
use File::Copy ();
use File::Path ();
use File::Spec ();
plan(tests => 10);

my $test_dir = File::Spec->catdir(qw(lib deprecate));
chdir $test_dir or die "Can't chdir $test_dir";
@INC = ( File::Spec->catdir( (File::Spec->updir)x3, qw(lib)) );

my %libdir = (
	privlibexp	=> File::Spec->catdir(qw(lib perl)),
	sitelibexp	=> File::Spec->catdir(qw(lib site)),
	archlibexp	=> File::Spec->catdir(qw(lib perl arch)),
	sitearchexp	=> File::Spec->catdir(qw(lib site arch)),
);

File::Path::make_path(values %libdir);

push @INC, @libdir{qw(archlibexp privlibexp sitearchexp sitelibexp)};

our %tests = (
	privlibexp	=> 1,
	sitelibexp	=> 0,
	archlibexp	=> 1,
	sitearchexp	=> 0,
);

no warnings 'once';
local %deprecate::Config = (%libdir);

my $module = 'Deprecated.pm';
for my $lib (sort keys %tests) {
    my $dir = $libdir{$lib};
    my $pm = File::Spec->catfile($dir, $module);
    File::Copy::copy($module, $pm);

my $warn = '';
    {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
        use warnings qw(deprecated);
#line 1001
	require Deprecated;
#line
    }
    if( $tests{$lib} ) {
        like($warn, qr/^Deprecated\s+will\s+be\s+removed\b/, "$lib - message");
        my $me = quotemeta($0);
        like($warn, qr/$me,?\s+line\s+1001\.?\n*$/, "$lib - location");
    }
    else {
	ok( !$warn, "$lib - no message" );
    }

delete $INC{$module};
    unlink_all $pm;
}

my $sub_dir = 'Optionally';
my $opt_mod = $sub_dir .'.pm';
for my $lib (sort keys %tests) {
    my $dir = File::Spec->catdir($libdir{$lib}, $sub_dir);
    File::Path::make_path($dir);

my $pm = File::Spec->catfile($dir, $module);
    File::Copy::copy($opt_mod, $pm);

my $warn = '';
    {   local $SIG{__WARN__} = sub { $warn .= $_[0]; };
        use warnings qw(deprecated);
	require Optionally::Deprecated;
    }
    if( $tests{$lib} ) {
        like($warn, qr/^Optionally::Deprecated\s+will\s+be\s+removed\b/,
		"$lib - use if - message");
    }
    else {
	ok( !$warn, "$lib - use if - no message" );
    }

delete $INC{"$sub_dir/$module"};
    unlink_all $pm;
}

END { File::Path::remove_tree('lib') }