1 files changed, 81 insertions, 0 deletions
diff --git a/cpan/autodie/t/internal-backcompat.t b/cpan/autodie/t/internal-backcompat.t
new file mode 100755
index 0000000000..9f7196c3c5
--- /dev/null
+++ b/cpan/autodie/t/internal-backcompat.t
@@ -0,0 +1,81 @@
+#!/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.
+
+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]) || croak "Can't open(@_): $!"	} elsif (@_ == 2) {
+return CORE::open($_[0], $_[1]) || croak "Can't open(@_): $!"	} elsif (@_ == 3) {
+return CORE::open($_[0], $_[1], @_[2..$#_]) || 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..$#_]) || 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..$#_]) || 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.