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 Fatal;
use Test::More 'no_plan';

# Tests to determine if Fatal's internal interfaces remain backwards
# compatible.
#
# WARNING: This file contains a lot of very ugly code, hard-coded
# strings, and nasty API calls.  It may frighten small children.
# Viewer discretion is advised.

# fill_protos.  This hasn't been changed since the original Fatal,
# and so should always be the same.

my %protos = (
    '$'     => [ [ 1, '$_[0]' ] ],
    '$$'    => [ [ 2, '$_[0]', '$_[1]' ] ],
    '$$@'   => [ [ 3, '$_[0]', '$_[1]', '@_[2..$#_]' ] ],
    '\$'    => [ [ 1, '${$_[0]}' ] ],
    '\%'    => [ [ 1, '%{$_[0]}' ] ],
    '\%;$*' => [ [ 1, '%{$_[0]}' ], [ 2, '%{$_[0]}', '$_[1]' ],
                 [ 3, '%{$_[0]}', '$_[1]', '$_[2]' ] ],
);

while (my ($proto, $code) = each %protos) {
    is_deeply( [ Fatal::fill_protos($proto) ], $code, $proto);
}

# write_invocation tests
no warnings 'qw';

# Technically the outputted code varies from the classical Fatal.
# However the changes are mostly whitespace.  Those that aren't are
# improvements to error messages or bug fixes.

my @write_invocation_calls = (
    [
        # Core  # Call          # Name  # Void  # Args
        [ 1,    'CORE::open',   'open', 0,      [ 1, qw($_[0]) ],
                                                [ 2, qw($_[0] $_[1]) ],
                                                [ 3, qw($_[0] $_[1] @_[2..$#_])]
        ],
        q{	if (@_ == 1) {
return CORE::open($_[0]) || Carp::croak("Can't open(@_): $!")	} elsif (@_ == 2) {
return CORE::open($_[0], $_[1]) || Carp::croak("Can't open(@_): $!")	} elsif (@_ >= 3) {
return CORE::open($_[0], $_[1], @_[2..$#_]) || Carp::croak("Can't open(@_): $!")
            }
            die "Internal error: open(@_): Do not expect to get ", scalar(@_), " arguments";
    }
    ]
);

foreach my $test (@write_invocation_calls) {
    is(Fatal::write_invocation( @{ $test->[0] } ), $test->[1], 'write_inovcation');
}

# one_invocation tests.

my @one_invocation_calls = (
        # Core  # Call          # Name  # Void   # Args
    [
        [ 1,    'CORE::open',   'open', 0,      qw($_[0] $_[1] @_[2..$#_]) ],
        q{return CORE::open($_[0], $_[1], @_[2..$#_]) || Carp::croak("Can't open(@_): $!")},
    ],
    [
        [ 1,    'CORE::open',   'open', 1,      qw($_[0] $_[1] @_[2..$#_]) ],
        q{return (defined wantarray)?CORE::open($_[0], $_[1], @_[2..$#_]):
                   CORE::open($_[0], $_[1], @_[2..$#_]) || Carp::croak("Can't open(@_): $!")},
    ],
);

foreach my $test (@one_invocation_calls) {
    is(Fatal::one_invocation( @{ $test->[0] } ), $test->[1], 'one_inovcation');
}

# TODO: _make_fatal
# Since this subroutine has always started with an underscore,
# I think it's pretty clear that it's internal-only.  I'm not
# testing it here, and it doesn't yet have backcompat.