5 use Test::More 'no_plan';
7 # Tests to determine if Fatal's internal interfaces remain backwards
10 # WARNING: This file contains a lot of very ugly code, hard-coded
11 # strings, and nasty API calls. It may frighten small children.
12 # Viewer discretion is advised.
14 # fill_protos. This hasn't been changed since the original Fatal,
15 # and so should always be the same.
18 '$' => [ [ 1, '$_[0]' ] ],
19 '$$' => [ [ 2, '$_[0]', '$_[1]' ] ],
20 '$$@' => [ [ 3, '$_[0]', '$_[1]', '@_[2..$#_]' ] ],
21 '\$' => [ [ 1, '${$_[0]}' ] ],
22 '\%' => [ [ 1, '%{$_[0]}' ] ],
23 '\%;$*' => [ [ 1, '%{$_[0]}' ], [ 2, '%{$_[0]}', '$_[1]' ],
24 [ 3, '%{$_[0]}', '$_[1]', '$_[2]' ] ],
27 while (my ($proto, $code) = each %protos) {
28 is_deeply( [ Fatal::fill_protos($proto) ], $code, $proto);
31 # write_invocation tests
34 # Technically the outputted code varies from the classical Fatal.
35 # However the changes are mostly whitespace. Those that aren't are
36 # improvements to error messages.
38 my @write_invocation_calls = (
40 # Core # Call # Name # Void # Args
41 [ 1, 'CORE::open', 'open', 0, [ 1, qw($_[0]) ],
42 [ 2, qw($_[0] $_[1]) ],
43 [ 3, qw($_[0] $_[1] @_[2..$#_])]
46 return CORE::open($_[0]) || croak "Can't open(@_): $!" } elsif (@_ == 2) {
47 return CORE::open($_[0], $_[1]) || croak "Can't open(@_): $!" } elsif (@_ == 3) {
48 return CORE::open($_[0], $_[1], @_[2..$#_]) || croak "Can't open(@_): $!"
50 die "Internal error: open(@_): Do not expect to get ", scalar(@_), " arguments";
55 foreach my $test (@write_invocation_calls) {
56 is(Fatal::write_invocation( @{ $test->[0] } ), $test->[1], 'write_inovcation');
59 # one_invocation tests.
61 my @one_invocation_calls = (
62 # Core # Call # Name # Void # Args
64 [ 1, 'CORE::open', 'open', 0, qw($_[0] $_[1] @_[2..$#_]) ],
65 q{return CORE::open($_[0], $_[1], @_[2..$#_]) || croak "Can't open(@_): $!"},
68 [ 1, 'CORE::open', 'open', 1, qw($_[0] $_[1] @_[2..$#_]) ],
69 q{return (defined wantarray)?CORE::open($_[0], $_[1], @_[2..$#_]):
70 CORE::open($_[0], $_[1], @_[2..$#_]) || croak "Can't open(@_): $!"},
74 foreach my $test (@one_invocation_calls) {
75 is(Fatal::one_invocation( @{ $test->[0] } ), $test->[1], 'one_inovcation');
79 # Since this subroutine has always started with an underscore,
80 # I think it's pretty clear that it's internal-only. I'm not
81 # testing it here, and it doesn't yet have backcompat.