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 Test::More;

use constant PERL510 => ( $] >= 5.010 );

BEGIN {
    if (not PERL510) {
        plan skip_all => "Only subroutine hints supported in 5.8.x";
    }
    else {
        plan 'no_plan';
    }
}

use FindBin;
use lib "$FindBin::Bin/lib";
use Hints_pod_examples qw(
	undef_scalar false_scalar zero_scalar empty_list default_list
	empty_or_false_list undef_n_error_list foo re_fail bar
	think_positive my_system
);
use autodie qw( !
	undef_scalar false_scalar zero_scalar empty_list default_list
	empty_or_false_list undef_n_error_list foo re_fail bar
	think_positive my_system
);

my %scalar_tests = (

# Test code             # Exception expected?

'undef_scalar()'        => 1,
    'undef_scalar(1)',      => 0,
    'undef_scalar(0)',      => 0,
    'undef_scalar("")',     => 0,

'false_scalar(0)',      => 1,
    'false_scalar()',       => 1,
    'false_scalar(undef)',  => 1,
    'false_scalar("")',     => 1,
    'false_scalar(1)',      => 0,
    'false_scalar("1")',    => 0,

'zero_scalar("0")',     => 1,
    'zero_scalar(0)',       => 1,
    'zero_scalar(1)',       => 0,
    'zero_scalar(undef)',   => 0,
    'zero_scalar("")',      => 0,

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

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

're_fail(-1)',          => 0,
    're_fail("FAIL")',      => 1,
    're_fail("_FAIL")',     => 1,
    're_fail("_fail")',     => 0,
    're_fail("fail")',      => 0,

'think_positive(-1)'    => 1,
    'think_positive(-2)'    => 1,
    'think_positive(0)'     => 0,
    'think_positive(1)'     => 0,
    'think_positive(2)'     => 0,

'my_system(1)'          => 1,
    'my_system(2)'          => 1,
    'my_system(0)'          => 0,

);

my %list_tests = (

'empty_list()',         => 1,
    'empty_list(())',       => 1,
    'empty_list([])',       => 0,
    'empty_list(0)',        => 0,
    'empty_list("")',       => 0,
    'empty_list(undef)',    => 0,

'default_list()',       => 1,
    'default_list(0)',      => 0,
    'default_list("")',     => 0,
    'default_list(undef)',  => 1,
    'default_list(1)',      => 0,
    'default_list("str")',  => 0,
    'default_list(1, 2)',   => 0,

'empty_or_false_list()',     => 1,
    'empty_or_false_list(())',   => 1,
    'empty_or_false_list(0)',    => 1,
    'empty_or_false_list(undef)',=> 1,
    'empty_or_false_list("")',   => 1,
    'empty_or_false_list("0")',  => 1,
    'empty_or_false_list(1,2)',  => 0,
    'empty_or_false_list("a")',  => 0,

'undef_n_error_list(undef, 1)'   => 1,
    'undef_n_error_list(undef, "a")' => 1,
    'undef_n_error_list()'           => 0,
    'undef_n_error_list(0, 1)'       => 0,
    'undef_n_error_list("", 1)'      => 0,
    'undef_n_error_list(1)'          => 0,

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

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

're_fail(-1)',          => 1,
    're_fail("FAIL")',      => 0,
    're_fail("_FAIL")',     => 0,
    're_fail("_fail")',     => 0,
    're_fail("fail")',      => 0,

'think_positive(-1)'    => 1,
    'think_positive(-2)'    => 1,
    'think_positive(0)'     => 0,
    'think_positive(1)'     => 0,
    'think_positive(2)'     => 0,

'my_system(1)'          => 1,
    'my_system(2)'          => 1,
    'my_system(0)'          => 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 = (
    PERL510 ?
    q{} :
    q{use autodie qw(
	undef_scalar false_scalar zero_scalar empty_list default_list
	empty_or_false_list undef_n_error_list foo re_fail bar
	think_positive my_system bizarro_system    
    );}
);

# Some of the tests provide different hints for scalar or list context
# NOTE: these tests are sensitive to order (not sure why) therefore
# this loop must use a sorted list of keys . Otherwise there is an occasional
# failure like this:
#
#   Failed test 'scalar test - zero_scalar("")'
#   at cpan/autodie/t/hints_pod_examples.t line 168.
#          got: 'Can't zero_scalar(''):  at cpan/autodie/t/hints_pod_examples.t line 157
# '
#     expected: ''
#
#
#         my $scalar = zero_scalar("");
#         1;

foreach my $test (sort keys %scalar_tests) {
    my $exception_expected= $scalar_tests{$test};
    my $ok= eval(my $code= "
        $perl58_fix
        my \$scalar = $test;
        1;
    ");

if ($exception_expected) {
        isnt($ok ? "" : "$@", "", "scalar test - $test")
            or diag($code);
    }
    else {
        is($ok ? "" : "$@", "", "scalar test - $test")
            or diag($code);
    }
}

# this set of test is not *known* to be order dependent however we sort it anyway out caution
foreach my $test (sort keys %list_tests) {
    my $exception_expected= $list_tests{$test};
    eval "
        $perl58_fix
        my \@array = $test;
    ";

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