Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
00-load.t	127 B	-r--r--r--	2014-12-27 11:48
Fatal.t	950 B	-r--r--r--	2014-12-27 11:48
args.t	1.32 KB	-r--r--r--	2014-12-27 11:48
autodie.t	2.51 KB	-r--r--r--	2014-12-27 11:48
autodie_skippy.pm	363 B	-r--r--r--	2014-12-27 11:48
autodie_test_module.pm	879 B	-r--r--r--	2014-12-27 11:48
backcompat.t	584 B	-r--r--r--	2014-12-27 11:48
basic_exceptions.t	1.4 KB	-r--r--r--	2014-12-27 11:48
binmode.t	682 B	-r--r--r--	2014-12-27 11:48
blog_hints.t	707 B	-r--r--r--	2014-12-27 11:48
caller.t	743 B	-r--r--r--	2014-12-27 11:48
chmod.t	529 B	-rwxr-xr-x	2014-12-27 11:48
chown.t	764 B	-r--r--r--	2014-12-27 11:48
context.t	1.31 KB	-r--r--r--	2014-12-27 11:48
context_lexical.t	1.61 KB	-r--r--r--	2014-12-27 11:48
core-trampoline-slurp.t	650 B	-r--r--r--	2014-12-27 11:48
crickey.t	667 B	-r--r--r--	2014-12-27 11:48
dbmopen.t	826 B	-r--r--r--	2014-12-27 11:48
eval_error.t	547 B	-r--r--r--	2014-12-27 11:48
exception_class.t	1.35 KB	-r--r--r--	2014-12-27 11:48
exceptions.t	1.27 KB	-r--r--r--	2014-12-27 11:48
exec.t	324 B	-r--r--r--	2014-12-27 11:48
filehandles.t	1.08 KB	-r--r--r--	2014-12-27 11:48
fileno.t	740 B	-r--r--r--	2014-12-27 11:48
flock.t	2.69 KB	-r--r--r--	2014-12-27 11:48
format-clobber.t	1.98 KB	-r--r--r--	2014-12-27 11:48
hints.t	3.86 KB	-r--r--r--	2014-12-27 11:48
hints_insist.t	643 B	-r--r--r--	2014-12-27 11:48
hints_pod_examples.t	5.29 KB	-r--r--r--	2014-12-27 11:48
hints_provider_does.t	543 B	-r--r--r--	2014-12-27 11:48
hints_provider_easy_does_it.t	551 B	-r--r--r--	2014-12-27 11:48
hints_provider_isa.t	542 B	-r--r--r--	2014-12-27 11:48
internal-backcompat.t	2.8 KB	-r--r--r--	2014-12-27 11:48
internal.t	866 B	-r--r--r--	2014-12-27 11:48
kill.t	650 B	-r--r--r--	2014-12-27 11:48
lethal.t	466 B	-r--r--r--	2014-12-27 11:48
mkdir.t	1.81 KB	-r--r--r--	2014-12-27 11:48
no_carp.t	195 B	-r--r--r--	2014-12-27 11:48
open.t	2.53 KB	-r--r--r--	2014-12-27 11:48
recv.t	1.53 KB	-r--r--r--	2014-12-27 11:48
repeat.t	382 B	-r--r--r--	2014-12-27 11:48
rt-74246.t	301 B	-r--r--r--	2014-12-27 11:48
scope_leak.t	2.33 KB	-r--r--r--	2014-12-27 11:49
skip.t	631 B	-r--r--r--	2014-12-27 11:48
string-eval-basic.t	624 B	-r--r--r--	2014-12-27 11:48
string-eval-leak.t	820 B	-r--r--r--	2014-12-27 11:48
sysopen.t	450 B	-r--r--r--	2014-12-27 11:48
touch_me	57 B	-r--r--r--	2014-12-27 11:48
truncate.t	3.35 KB	-r--r--r--	2014-12-27 11:49
truncate_me	0 B	-rw-r--r--	2016-10-10 18:14
unlink.t	1.64 KB	-r--r--r--	2014-12-27 11:48
user-context.t	1.27 KB	-r--r--r--	2014-12-27 11:48
usersub.t	1.28 KB	-r--r--r--	2014-12-27 11:48
utf8_open.t	3.04 KB	-r--r--r--	2014-12-27 11:48
utime.t	840 B	-r--r--r--	2014-12-27 11:48
version.t	626 B	-r--r--r--	2014-12-27 11:48
version_tag.t	2.06 KB	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/bin/perl -w
use strict;
use warnings;
use autodie::hints;

use FindBin;
use lib "$FindBin::Bin/lib";

use File::Copy qw(copy move cp mv);

use Test::More 'no_plan';

use constant NO_SUCH_FILE  => "this_file_had_better_not_exist";
use constant NO_SUCH_FILE2 => "this_file_had_better_not_exist_xyzzy";

use constant PERL510  => ( $] >= 5.0100 );
use constant PERL5101 => ( $] >= 5.0101 );
use constant PERL5102 => ( $] >= 5.0102 );

# File::Copy states that all subroutines return '0' on failure.
# However both Windows and VMS may return other false values
# (notably empty-string) on failure.  This constant indicates
# whether we should skip some tests because the return values
# from File::Copy may not be what's in the documentation.

use constant WEIRDO_FILE_COPY =>
    ( ! PERL5102 and ( $^O eq "MSWin32" or $^O eq "VMS" ));

use Hints_test qw(
    fail_on_empty fail_on_false fail_on_undef
);

use autodie qw(fail_on_empty fail_on_false fail_on_undef);

diag("Sub::Identify ", exists( $INC{'Sub/Identify.pm'} ) ? "is" : "is not",
     " loaded") if (! $ENV{PERL_CORE});

my $hints = "autodie::hints";

# Basic hinting tests

is( $hints->sub_fullname(\&copy), 'File::Copy::copy' , "Id: copy" );
is(
    $hints->sub_fullname(\&cp),
    PERL5101 ? 'File::Copy::cp' : 'File::Copy::copy' , "Id: cp"
);

is( $hints->sub_fullname(\&move), 'File::Copy::move' , "Id: move" );
is( $hints->sub_fullname(\&mv),
    PERL5101 ? 'File::Copy::mv' : 'File::Copy::move' , "Id: mv"
);

if (PERL510) {
    ok( $hints->get_hints_for(\&copy)->{scalar}->(0) ,
        "copy() hints should fail on 0 for scalars."
    );
    ok( $hints->get_hints_for(\&copy)->{list}->(0) ,
        "copy() hints should fail on 0 for lists."
    );
}

# Scalar context test

eval {
    use autodie qw(copy);

my $scalar_context = copy(NO_SUCH_FILE, NO_SUCH_FILE2);
};

isnt("$@", "", "Copying in scalar context should throw an error.");
isa_ok($@, "autodie::exception");

is($@->function, "File::Copy::copy", "Function should be original name");

SKIP: {
    skip("File::Copy is weird on Win32/VMS before 5.10.1", 1)
        if WEIRDO_FILE_COPY;

is($@->return, 0, "File::Copy returns zero on failure");
}

is($@->context, "scalar", "File::Copy called in scalar context");

# List context test.

eval {
    use autodie qw(copy);

my @list_context = copy(NO_SUCH_FILE, NO_SUCH_FILE2);
};

isnt("$@", "", "Copying in list context should throw an error.");
isa_ok($@, "autodie::exception");

is($@->function, "File::Copy::copy", "Function should be original name");

SKIP: {
    skip("File::Copy is weird on Win32/VMS before 5.10.1", 1)
        if WEIRDO_FILE_COPY;

is_deeply($@->return, [0], "File::Copy returns zero on failure");
}
is($@->context, "list", "File::Copy called in list context");

# Tests on loaded funcs.

my %tests = (

# Test code             # Exception expected?

'fail_on_empty()'       => 1,
    'fail_on_empty(0)'      => 0,
    'fail_on_empty(undef)'  => 0,
    'fail_on_empty(1)'      => 0,

'fail_on_false()'       => 1,
    'fail_on_false(0)'      => 1,
    'fail_on_false(undef)'  => 1,
    'fail_on_false(1)'      => 0,

'fail_on_undef()'       => 1,
    'fail_on_undef(0)'      => 0,
    'fail_on_undef(undef)'  => 1,
    'fail_on_undef(1)'      => 0,

);

# On Perl 5.8, autodie doesn't correctly propagate into string evals.
# The following snippet forces the use of autodie inside the eval if
# we really really have to.  For 5.10+, we don't want to include this
# fix, because the tests will act as a canary if we screw up string
# eval propagation.

my $perl58_fix = (
    $] >= 5.010 ?
    "" :
    "use autodie qw(fail_on_empty fail_on_false fail_on_undef); "
);

while (my ($test, $exception_expected) = each %tests) {
    eval "
        $perl58_fix
        my \@array = $test;
    ";

if ($exception_expected) {
        isnt("$@", "", $test);
    }
    else {
        is($@, "", $test);
    }
}