summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2009-05-14 15:06:08 +0200
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2009-05-14 15:06:08 +0200
commit8024b5df24675d60f6262988f448e15a0d1f5af0 (patch)
treeb04d5e4f9945f3d0309ae0314c1607ab77c4cbde /lib
parent233b59f5c897689b9082b1c3a2b12d17f71582c4 (diff)
downloadperl-8024b5df24675d60f6262988f448e15a0d1f5af0.tar.gz
Move autodie tests in lib/autodie/t, so they are picked up by t/harness
Diffstat (limited to 'lib')
-rw-r--r--lib/autodie/t/00-load.t9
-rw-r--r--lib/autodie/t/Fatal.t36
-rw-r--r--lib/autodie/t/autodie.t103
-rw-r--r--lib/autodie/t/autodie_test_module.pm18
-rw-r--r--lib/autodie/t/backcompat.t14
-rw-r--r--lib/autodie/t/basic_exceptions.t46
-rw-r--r--lib/autodie/t/binmode.t33
-rw-r--r--lib/autodie/t/caller.t34
-rw-r--r--lib/autodie/t/context.t66
-rw-r--r--lib/autodie/t/context_lexical.t80
-rw-r--r--lib/autodie/t/crickey.t27
-rw-r--r--lib/autodie/t/dbmopen.t36
-rw-r--r--lib/autodie/t/exception_class.t57
-rw-r--r--lib/autodie/t/exceptions.t45
-rw-r--r--lib/autodie/t/exec.t12
-rw-r--r--lib/autodie/t/filehandles.t60
-rw-r--r--lib/autodie/t/fileno.t35
-rw-r--r--lib/autodie/t/flock.t90
-rw-r--r--lib/autodie/t/internal.t33
-rw-r--r--lib/autodie/t/lethal.t17
-rw-r--r--lib/autodie/t/lib/Caller_helper.pm13
-rw-r--r--lib/autodie/t/lib/autodie/test/au.pm14
-rw-r--r--lib/autodie/t/lib/autodie/test/au/exception.pm19
-rw-r--r--lib/autodie/t/lib/autodie/test/badname.pm8
-rw-r--r--lib/autodie/t/lib/autodie/test/missing.pm8
-rw-r--r--lib/autodie/t/lib/lethal.pm8
-rw-r--r--lib/autodie/t/lib/pujHa/ghach.pm26
-rw-r--r--lib/autodie/t/lib/pujHa/ghach/Dotlh.pm59
-rw-r--r--lib/autodie/t/mkdir.t69
-rw-r--r--lib/autodie/t/open.t18
-rw-r--r--lib/autodie/t/recv.t60
-rw-r--r--lib/autodie/t/repeat.t19
-rw-r--r--lib/autodie/t/scope_leak.t78
-rw-r--r--lib/autodie/t/sysopen.t23
-rw-r--r--lib/autodie/t/truncate.t53
-rw-r--r--lib/autodie/t/unlink.t52
-rw-r--r--lib/autodie/t/user-context.t59
-rw-r--r--lib/autodie/t/usersub.t64
-rw-r--r--lib/autodie/t/version.t17
-rw-r--r--lib/autodie/t/version_tag.t26
40 files changed, 1544 insertions, 0 deletions
diff --git a/lib/autodie/t/00-load.t b/lib/autodie/t/00-load.t
new file mode 100644
index 0000000000..d07fcaefbe
--- /dev/null
+++ b/lib/autodie/t/00-load.t
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Fatal' );
+}
+
+# diag( "Testing Fatal $Fatal::VERSION, Perl $], $^X" );
diff --git a/lib/autodie/t/Fatal.t b/lib/autodie/t/Fatal.t
new file mode 100644
index 0000000000..a291837d13
--- /dev/null
+++ b/lib/autodie/t/Fatal.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl -w
+use strict;
+
+use constant NO_SUCH_FILE => "this_file_or_dir_had_better_not_exist_XYZZY";
+
+use Test::More tests => 17;
+
+use Fatal qw(open close :void opendir);
+
+eval { open FOO, "<".NO_SUCH_FILE }; # Two arg open
+like($@, qr/^Can't open/, q{Package Fatal::open});
+is(ref $@, "", "Regular fatal throws a string");
+
+my $foo = 'FOO';
+for ('$foo', "'$foo'", "*$foo", "\\*$foo") {
+ eval qq{ open $_, '<$0' };
+
+ is($@,"", "Open using filehandle named - $_");
+
+ like(scalar(<$foo>), qr{^#!.*/perl}, "File contents using - $_");
+ eval qq{ close FOO };
+
+ is($@,"", "Close filehandle using - $_");
+}
+
+eval { opendir FOO, NO_SUCH_FILE };
+like($@, qr{^Can't open}, "Package :void Fatal::opendir");
+
+eval { my $a = opendir FOO, NO_SUCH_FILE };
+is($@, "", "Package :void Fatal::opendir in scalar context");
+
+eval { Fatal->import(qw(print)) };
+like(
+ $@, qr{Cannot make the non-overridable builtin print fatal},
+ "Can't override print"
+);
diff --git a/lib/autodie/t/autodie.t b/lib/autodie/t/autodie.t
new file mode 100644
index 0000000000..c528a160a4
--- /dev/null
+++ b/lib/autodie/t/autodie.t
@@ -0,0 +1,103 @@
+#!/usr/bin/perl -w
+use strict;
+
+use constant NO_SUCH_FILE => 'this_file_had_so_better_not_be_here';
+
+use Test::More tests => 19;
+
+{
+
+ use autodie qw(open);
+
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+ like($@,qr{Can't open},"autodie qw(open) in lexical scope");
+
+ no autodie qw(open);
+
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+ is($@,"","no autodie qw(open) in lexical scope");
+
+ use autodie qw(open);
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+ like($@,qr{Can't open},"autodie qw(open) in lexical scope 2");
+
+ no autodie; # Should turn off all autodying subs
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+ is($@,"","no autodie in lexical scope 2");
+
+ # Turn our pragma on one last time, so we can verify that
+ # falling out of this block reverts it back to previous
+ # behaviour.
+ use autodie qw(open);
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+ like($@,qr{Can't open},"autodie qw(open) in lexical scope 3");
+
+}
+
+eval { open(my $fh, '<', NO_SUCH_FILE); };
+is($@,"","autodie open outside of lexical scope");
+
+eval {
+ use autodie; # Should turn on everything
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+like($@, qr{Can't open}, "vanilla use autodie turns on everything.");
+
+eval { open(my $fh, '<', NO_SUCH_FILE); };
+is($@,"","vanilla autodie cleans up");
+
+{
+ use autodie qw(:io);
+
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+ like($@,qr{Can't open},"autodie q(:io) makes autodying open");
+
+ no autodie qw(:io);
+
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+ is($@,"", "no autodie qw(:io) disabled autodying open");
+}
+
+{
+ package Testing_autodie;
+
+ use Test::More;
+
+ use constant NO_SUCH_FILE => ::NO_SUCH_FILE();
+
+ use Fatal qw(open);
+
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+
+ like($@, qr{Can't open}, "Package fatal working");
+ is(ref $@,"","Old Fatal throws strings");
+
+ {
+ use autodie qw(open);
+
+ ok(1,"use autodie allowed with Fatal");
+
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+ like($@, qr{Can't open}, "autodie and Fatal works");
+ isa_ok($@, "autodie::exception"); # autodie throws real exceptions
+
+ }
+
+ eval { open(my $fh, '<', NO_SUCH_FILE); };
+
+ like($@, qr{Can't open}, "Package fatal working after autodie");
+ is(ref $@,"","Old Fatal throws strings after autodie");
+
+ eval " no autodie qw(open); ";
+
+ ok($@,"no autodie on Fataled sub an error.");
+
+ eval "
+ no autodie qw(close);
+ use Fatal 'close';
+ ";
+
+ like($@, qr{not allowed}, "Using fatal after autodie is an error.");
+}
+
diff --git a/lib/autodie/t/autodie_test_module.pm b/lib/autodie/t/autodie_test_module.pm
new file mode 100644
index 0000000000..e8e824c522
--- /dev/null
+++ b/lib/autodie/t/autodie_test_module.pm
@@ -0,0 +1,18 @@
+package main;
+use strict;
+use warnings;
+
+# Calls open, while still in the main package. This shouldn't
+# be autodying.
+sub leak_test {
+ return open(my $fh, '<', $_[0]);
+}
+
+package autodie_test_module;
+
+# This should be calling CORE::open
+sub your_open {
+ return open(my $fh, '<', $_[0]);
+}
+
+1;
diff --git a/lib/autodie/t/backcompat.t b/lib/autodie/t/backcompat.t
new file mode 100644
index 0000000000..acb81245b8
--- /dev/null
+++ b/lib/autodie/t/backcompat.t
@@ -0,0 +1,14 @@
+#!/usr/bin/perl -w
+use strict;
+use Fatal qw(open);
+use Test::More tests => 2;
+use constant NO_SUCH_FILE => "xyzzy_this_file_is_not_here";
+
+eval {
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+my $old_msg = qr{Can't open\(GLOB\(0x[0-9a-f]+\), <, xyzzy_this_file_is_not_here\): .* at \(eval \d+\)(?:\[.*?\])? line \d+\s+main::__ANON__\('GLOB\(0x[0-9a-f]+\)',\s*'<',\s*'xyzzy_this_file_is_not_here'\) called at \S+ line \d+\s+eval \Q{...}\E called at \S+ line \d+};
+
+like($@,$old_msg,"Backwards compat ugly messages");
+is(ref($@),"", "Exception is a string, not an object");
diff --git a/lib/autodie/t/basic_exceptions.t b/lib/autodie/t/basic_exceptions.t
new file mode 100644
index 0000000000..56876be481
--- /dev/null
+++ b/lib/autodie/t/basic_exceptions.t
@@ -0,0 +1,46 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More tests => 17;
+
+use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
+
+my $line;
+
+eval {
+ use autodie ':io';
+ $line = __LINE__; open(my $fh, '<', NO_SUCH_FILE);
+};
+
+like($@, qr/Can't open '\w+' for reading: /, "Prety printed open msg");
+like($@, qr{\Q$0\E}, "Our file mention in error message");
+
+like($@, qr{for reading: '.+'}, "Error should be in single-quotes");
+like($@->errno,qr/./, "Errno should not be empty");
+
+like($@, qr{\n$}, "Errors should end with a newline");
+is($@->file, $0, "Correct file");
+is($@->function, 'CORE::open', "Correct dying sub");
+is($@->package, __PACKAGE__, "Correct package");
+is($@->caller,__PACKAGE__."::__ANON__", "Correct caller");
+is($@->line, $line, "Correct line");
+is($@->args->[1], '<', 'Correct mode arg');
+is($@->args->[2], NO_SUCH_FILE, 'Correct filename arg');
+ok($@->matches('open'), 'Looks like an error from open');
+ok($@->matches(':io'), 'Looks like an error from :io');
+
+# Testing of caller info with a real subroutine.
+
+my $line2;
+
+sub xyzzy {
+ use autodie ':io';
+ $line2 = __LINE__; open(my $fh, '<', NO_SUCH_FILE);
+ return;
+};
+
+eval { xyzzy(); };
+
+isa_ok($@, 'autodie::exception');
+is($@->caller, __PACKAGE__."::xyzzy", "Subroutine caller test");
+is($@->line, $line2, "Subroutine line test");
diff --git a/lib/autodie/t/binmode.t b/lib/autodie/t/binmode.t
new file mode 100644
index 0000000000..317a41303c
--- /dev/null
+++ b/lib/autodie/t/binmode.t
@@ -0,0 +1,33 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More 'no_plan';
+
+# These are a bunch of general tests for working with files and
+# filehandles.
+
+my $r = "default";
+
+eval {
+ no warnings;
+ $r = binmode(FOO);
+};
+
+is($@,"","Sanity: binmode(FOO) doesn't usually throw exceptions");
+is($r,undef,"Sanity: binmode(FOO) returns undef");
+
+eval {
+ use autodie qw(binmode);
+ no warnings;
+ binmode(FOO);
+};
+
+ok($@, "autodie qw(binmode) should cause failing binmode to die.");
+isa_ok($@,"autodie::exception", "binmode exceptions are in autodie::exception");
+
+eval {
+ use autodie;
+ no warnings;
+ binmode(FOO);
+};
+
+ok($@, "autodie (default) should cause failing binmode to die.");
diff --git a/lib/autodie/t/caller.t b/lib/autodie/t/caller.t
new file mode 100644
index 0000000000..1874353627
--- /dev/null
+++ b/lib/autodie/t/caller.t
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use autodie;
+use Test::More 'no_plan';
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+use Caller_helper;
+
+use constant NO_SUCH_FILE => "kiwifoo_is_so_much_fun";
+
+eval {
+ foo();
+};
+
+isa_ok($@, 'autodie::exception');
+
+is($@->caller, 'main::foo', "Caller should be main::foo");
+
+sub foo {
+ use autodie;
+ open(my $fh, '<', NO_SUCH_FILE);
+}
+
+eval {
+ Caller_helper::foo();
+};
+
+isa_ok($@, 'autodie::exception');
+
+is($@->line, $Caller_helper::line, "External line number check");
+is($@->file, $INC{"Caller_helper.pm"}, "External filename check");
+is($@->package, "Caller_helper", "External package check");
+is($@->caller, "Caller_helper::foo", "External subname check");
diff --git a/lib/autodie/t/context.t b/lib/autodie/t/context.t
new file mode 100644
index 0000000000..39b86497c6
--- /dev/null
+++ b/lib/autodie/t/context.t
@@ -0,0 +1,66 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More;
+
+plan 'no_plan';
+
+sub list_return {
+ return if @_;
+ return qw(foo bar baz);
+}
+
+sub list_return2 {
+ return if @_;
+ return qw(foo bar baz);
+}
+
+# Returns a list presented to it, but also returns a single
+# undef if given a list of a single undef. This mimics the
+# behaviour of many user-defined subs and built-ins (eg: open) that
+# always return undef regardless of context.
+
+sub list_mirror {
+ return undef if (@_ == 1 and not defined $_[0]);
+ return @_;
+
+}
+
+use Fatal qw(list_return);
+use Fatal qw(:void list_return2);
+
+TODO: {
+
+ # Clobbering context was documented as a bug in the original
+ # Fatal, so we'll still consider it a bug here.
+
+ local $TODO = "Fatal clobbers context, just like it always has.";
+
+ my @list = list_return();
+
+ is_deeply(\@list,[qw(foo bar baz)],'fatal sub works in list context');
+}
+
+eval {
+ my @line = list_return(1); # Should die
+};
+
+ok($@,"List return fatalised");
+
+### Tests where we've fatalised our function with :void ###
+
+my @list2 = list_return2();
+
+is_deeply(\@list2,[qw(foo bar baz)],'fatal sub works in list context');
+
+eval {
+ my @line = list_return2(1); # Shouldn't die
+};
+
+ok(! $@,"void List return fatalised survives when non-void");
+
+eval {
+ list_return2(1);
+};
+
+ok($@,"void List return fatalised");
diff --git a/lib/autodie/t/context_lexical.t b/lib/autodie/t/context_lexical.t
new file mode 100644
index 0000000000..eeb1a547d2
--- /dev/null
+++ b/lib/autodie/t/context_lexical.t
@@ -0,0 +1,80 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More;
+
+plan 'no_plan';
+
+# Returns a list presented to it, but also returns a single
+# undef if given a list of a single undef. This mimics the
+# behaviour of many user-defined subs and built-ins (eg: open) that
+# always return undef regardless of context.
+
+sub list_mirror {
+ return undef if (@_ == 1 and not defined $_[0]);
+ return @_;
+
+}
+
+### autodie clobbering tests ###
+
+eval {
+ list_mirror();
+};
+
+is($@, "", "No autodie, no fatality");
+
+eval {
+ use autodie qw(list_mirror);
+ list_mirror();
+};
+
+ok($@, "Autodie fatality for empty return in void context");
+
+eval {
+ list_mirror();
+};
+
+is($@, "", "No autodie, no fatality (after autodie used)");
+
+eval {
+ use autodie qw(list_mirror);
+ list_mirror(undef);
+};
+
+ok($@, "Autodie fatality for undef return in void context");
+
+eval {
+ use autodie qw(list_mirror);
+ my @list = list_mirror();
+};
+
+ok($@,"Autodie fatality for empty list return");
+
+eval {
+ use autodie qw(list_mirror);
+ my @list = list_mirror(undef);
+};
+
+ok($@,"Autodie fatality for undef list return");
+
+eval {
+ use autodie qw(list_mirror);
+ my @list = list_mirror("tada");
+};
+
+ok(! $@,"No Autodie fatality for defined list return");
+
+eval {
+ use autodie qw(list_mirror);
+ my $single = list_mirror("tada");
+};
+
+ok(! $@,"No Autodie fatality for defined scalar return");
+
+eval {
+ use autodie qw(list_mirror);
+ my $single = list_mirror(undef);
+};
+
+ok($@,"Autodie fatality for undefined scalar return");
diff --git a/lib/autodie/t/crickey.t b/lib/autodie/t/crickey.t
new file mode 100644
index 0000000000..91a7d7837a
--- /dev/null
+++ b/lib/autodie/t/crickey.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+use strict;
+use FindBin;
+use Test::More 'no_plan';
+
+use lib "$FindBin::Bin/lib";
+
+use constant NO_SUCH_FILE => "crickey_mate_this_file_isnt_here_either";
+
+use autodie::test::au qw(open);
+
+eval {
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+ok(my $e = $@, 'Strewth! autodie::test::au should throw an exception on failure');
+
+isa_ok($e, 'autodie::test::au::exception',
+ 'Yeah mate, that should be our test exception.');
+
+like($e, qr/time for a beer/, "Time for a beer mate?");
+
+like( eval { $e->time_for_a_beer; },
+ qr/time for a beer/, "It's always a good time for a beer."
+);
+
+ok($e->matches('open'), "Should be a fair dinkum error from open");
diff --git a/lib/autodie/t/dbmopen.t b/lib/autodie/t/dbmopen.t
new file mode 100644
index 0000000000..31698e65be
--- /dev/null
+++ b/lib/autodie/t/dbmopen.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More qw(no_plan);
+
+use constant ERROR_REGEXP => qr{Can't dbmopen\(%hash, 'foo/bar/baz', 0666\):};
+
+my $return = "default";
+
+eval {
+ $return = dbmopen(my %foo, "foo/bar/baz", 0666);
+};
+
+ok(!$return, "Sanity: dbmopen usually returns false on failure");
+ok(!$@, "Sanity: dbmopen doesn't usually throw exceptions");
+
+eval {
+ use autodie;
+
+ dbmopen(my %foo, "foo/bar/baz", 0666);
+};
+
+ok($@, "autodie allows dbmopen to throw errors.");
+isa_ok($@, "autodie::exception", "... errors are of the correct type");
+
+like($@, ERROR_REGEXP, "Message should include number in octal, not decimal");
+
+eval {
+ use autodie;
+
+ my %bar = ( foo => 1, bar => 2 );
+
+ dbmopen(%bar, "foo/bar/baz", 0666);
+};
+
+like($@, ERROR_REGEXP, "Correct formatting even with non-empty dbmopen hash");
+
diff --git a/lib/autodie/t/exception_class.t b/lib/autodie/t/exception_class.t
new file mode 100644
index 0000000000..127893bcbf
--- /dev/null
+++ b/lib/autodie/t/exception_class.t
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -w
+use strict;
+
+use FindBin;
+use Test::More 'no_plan';
+
+use lib "$FindBin::Bin/lib";
+
+use constant NO_SUCH_FILE => "this_file_had_better_not_exist_xyzzy";
+
+### Tests with non-existent exception class.
+
+my $open_success = eval {
+ use autodie::test::missing qw(open); # Uses non-existent exceptions
+ open(my $fh, '<', NO_SUCH_FILE);
+ 1;
+};
+
+is($open_success,undef,"Open should fail");
+
+isnt($@,"",'$@ should not be empty');
+
+is(ref($@),"",'$@ should not be a reference or object');
+
+like($@, qr/Failed to load/, '$@ should contain bad exception class msg');
+
+#### Tests with malformed exception class.
+
+my $open_success2 = eval {
+ use autodie::test::badname qw(open);
+ open(my $fh, '<', NO_SUCH_FILE);
+ 1;
+};
+
+is($open_success2,undef,"Open should fail");
+
+isnt($@,"",'$@ should not be empty');
+
+is(ref($@),"",'$@ should not be a reference or object');
+
+like($@, qr/Bad exception class/, '$@ should contain bad exception class msg');
+
+### Tests with well-formed exception class (in Klingon)
+
+my $open_success3 = eval {
+ use pujHa'ghach qw(open); #' <-- this makes my editor happy
+ open(my $fh, '<', NO_SUCH_FILE);
+ 1;
+};
+
+is($open_success3,undef,"Open should fail");
+
+isnt("$@","",'$@ should not be empty');
+
+isa_ok($@, "pujHa'ghach::Dotlh", '$@ should be a Klingon exception');
+
+like($@, qr/lujqu'/, '$@ should contain Klingon text');
diff --git a/lib/autodie/t/exceptions.t b/lib/autodie/t/exceptions.t
new file mode 100644
index 0000000000..2f8c2382fc
--- /dev/null
+++ b/lib/autodie/t/exceptions.t
@@ -0,0 +1,45 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More;
+
+BEGIN { plan skip_all => "Perl 5.10 only tests" if $] < 5.010; }
+
+# These are tests that depend upon 5.10 (eg, smart-match).
+# Basic tests should go in basic_exceptions.t
+
+use 5.010;
+use constant NO_SUCH_FILE => 'this_file_had_better_not_exist_xyzzy';
+
+plan 'no_plan';
+
+eval {
+ use autodie ':io';
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+ok($@, "Exception thrown" );
+ok($@ ~~ 'open', "Exception from open" );
+ok($@ ~~ ':file', "Exception from open / class :file" );
+ok($@ ~~ ':io', "Exception from open / class :io" );
+ok($@ ~~ ':all', "Exception from open / class :all" );
+
+eval {
+ no warnings 'once'; # To prevent the following close from complaining.
+ close(THIS_FILEHANDLE_AINT_OPEN);
+};
+
+ok(! $@, "Close without autodie should fail silent");
+
+eval {
+ use autodie ':io';
+ close(THIS_FILEHANDLE_AINT_OPEN);
+};
+
+like($@, qr{Can't close filehandle 'THIS_FILEHANDLE_AINT_OPEN'},"Nice msg from close");
+
+ok($@, "Exception thrown" );
+ok($@ ~~ 'close', "Exception from close" );
+ok($@ ~~ ':file', "Exception from close / class :file" );
+ok($@ ~~ ':io', "Exception from close / class :io" );
+ok($@ ~~ ':all', "Exception from close / class :all" );
+
diff --git a/lib/autodie/t/exec.t b/lib/autodie/t/exec.t
new file mode 100644
index 0000000000..0d4439a8c1
--- /dev/null
+++ b/lib/autodie/t/exec.t
@@ -0,0 +1,12 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 3;
+
+eval {
+ use autodie qw(exec);
+ exec("this_command_had_better_not_exist", 1);
+};
+
+isa_ok($@,"autodie::exception", "failed execs should die");
+ok($@->matches('exec'), "exception should match exec");
+ok($@->matches(':system'), "exception should match :system");
diff --git a/lib/autodie/t/filehandles.t b/lib/autodie/t/filehandles.t
new file mode 100644
index 0000000000..5bdf732e2c
--- /dev/null
+++ b/lib/autodie/t/filehandles.t
@@ -0,0 +1,60 @@
+#!/usr/bin/perl -w
+
+package main;
+
+use strict;
+use Test::More;
+
+# We may see failures with package filehandles if Fatal/autodie
+# incorrectly pulls out a cached subroutine from a different package.
+
+# We're using Fatal because package filehandles are likely to
+# see more use with Fatal than autodie.
+
+use Fatal qw(open);
+
+eval {
+ open(FILE, '<', $0);
+};
+
+
+if ($@) {
+ # Holy smokes! We couldn't even open our own file, bail out...
+
+ plan skip_all => q{Can't open $0 for filehandle tests}
+}
+
+plan tests => 4;
+
+my $line = <FILE>;
+
+like($line, qr{perl}, 'Looks like we opened $0 correctly');
+
+close(FILE);
+
+package autodie::test;
+use Test::More;
+
+use Fatal qw(open);
+
+eval {
+ open(FILE2, '<', $0);
+};
+
+is($@,"",'Opened $0 in autodie::test');
+
+my $line2 = <FILE2>;
+
+like($line2, qr{perl}, '...and we can read from $0 fine');
+
+close(FILE2);
+
+package main;
+
+# This shouldn't read anything, because FILE2 should be inside
+# autodie::test
+
+no warnings; # Otherwise we see problems with FILE2
+my $wrong_line = <FILE2>;
+
+ok(! defined($wrong_line),q{Filehandles shouldn't leak between packages});
diff --git a/lib/autodie/t/fileno.t b/lib/autodie/t/fileno.t
new file mode 100644
index 0000000000..2b9c2598e7
--- /dev/null
+++ b/lib/autodie/t/fileno.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 8;
+
+# Basic sanity tests.
+is(fileno(STDIN), 0, "STDIN fileno looks sane");
+is(fileno(STDOUT),1, "STDOUT looks sane");
+
+my $dummy = "foo";
+
+ok(!defined(fileno($dummy)), "Non-filehandles shouldn't be defined.");
+
+
+my $fileno = eval {
+ use autodie qw(fileno);
+ fileno(STDIN);
+};
+
+is($@,"","fileno(STDIN) shouldn't die");
+is($fileno,0,"autodying fileno(STDIN) should be 0");
+
+$fileno = eval {
+ use autodie qw(fileno);
+ fileno(STDOUT);
+};
+
+is($@,"","fileno(STDOUT) shouldn't die");
+is($fileno,1,"autodying fileno(STDOUT) should be 1");
+
+$fileno = eval {
+ use autodie qw(fileno);
+ fileno($dummy);
+};
+
+isa_ok($@,"autodie::exception", 'autodying fileno($dummy) should die');
diff --git a/lib/autodie/t/flock.t b/lib/autodie/t/flock.t
new file mode 100644
index 0000000000..8b2a168398
--- /dev/null
+++ b/lib/autodie/t/flock.t
@@ -0,0 +1,90 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More;
+use Fcntl qw(:flock);
+use POSIX qw(EWOULDBLOCK);
+
+require Fatal;
+
+my $EWOULDBLOCK = eval { EWOULDBLOCK() }
+ || $Fatal::_EWOULDBLOCK{$^O}
+ || plan skip_all => "EWOULDBLOCK not defined on this system";
+
+my ($self_fh, $self_fh2);
+
+eval {
+ use autodie;
+ open($self_fh, '<', $0);
+ open($self_fh2, '<', $0);
+ open(SELF, '<', $0);
+};
+
+if ($@) {
+ plan skip_all => "Cannot lock this test on this system.";
+}
+
+my $flock_return = flock($self_fh, LOCK_EX | LOCK_NB);
+
+if (not $flock_return) {
+ plan skip_all => "flock on my own test not supported on this system.";
+}
+
+my $flock_return2 = flock($self_fh2, LOCK_EX | LOCK_NB);
+
+if ($flock_return2) {
+ plan skip_all => "this test requires locking a file twice with ".
+ "different filehandles to fail";
+}
+
+$flock_return = flock($self_fh, LOCK_UN);
+
+if (not $flock_return) {
+ plan skip_all => "Odd, I can't unlock a file with flock on this system.";
+}
+
+# If we're here, then we can lock and unlock our own file.
+
+plan 'no_plan';
+
+ok( flock($self_fh, LOCK_EX | LOCK_NB), "Test file locked");
+
+my $return;
+
+eval {
+ use autodie qw(flock);
+ $return = flock($self_fh2, LOCK_EX | LOCK_NB);
+};
+
+is($!+0, $EWOULDBLOCK, "Double-flocking should be EWOULDBLOCK");
+ok(!$return, "flocking a file twice should fail");
+is($@, "", "Non-blocking flock should not fail on EWOULDBLOCK");
+
+__END__
+
+# These are old tests which I'd love to resurrect, but they need
+# a reliable way of getting flock to throw exceptions but with
+# minimal blocking. They may turn into author tests.
+
+eval {
+ use autodie;
+ flock($self_fh2, LOCK_EX | LOCK_NB);
+};
+
+ok($@, "Locking a file twice throws an exception with vanilla autodie");
+isa_ok($@, "autodie::exception", "Exception is from autodie::exception");
+
+like($@, qr/LOCK_EX/, "error message contains LOCK_EX switch");
+like($@, qr/LOCK_NB/, "error message contains LOCK_NB switch");
+unlike($@, qr/GLOB/ , "error doesn't include ugly GLOB mention");
+
+eval {
+ use autodie;
+ flock(SELF, LOCK_EX | LOCK_NB);
+};
+
+ok($@, "Locking a package filehanlde twice throws exception with vanilla autodie");
+isa_ok($@, "autodie::exception", "Exception is from autodie::exception");
+
+like($@, qr/LOCK_EX/, "error message contains LOCK_EX switch");
+like($@, qr/LOCK_NB/, "error message contains LOCK_NB switch");
+like($@, qr/SELF/ , "error mentions actual filehandle name.");
diff --git a/lib/autodie/t/internal.t b/lib/autodie/t/internal.t
new file mode 100644
index 0000000000..c1189444cb
--- /dev/null
+++ b/lib/autodie/t/internal.t
@@ -0,0 +1,33 @@
+#!/usr/bin/perl -w
+use strict;
+
+use constant NO_SUCH_FILE => "this_file_or_dir_had_better_not_exist_XYZZY";
+
+use Test::More tests => 6;
+
+# Lexical tests using the internal interface.
+
+eval { Fatal->import(qw(:lexical :void)) };
+like($@, qr{:void cannot be used with lexical}, ":void can't be used with :lexical");
+
+eval { Fatal->import(qw(open close :lexical)) };
+like($@, qr{:lexical must be used as first}, ":lexical must come first");
+
+{
+ use Fatal qw(:lexical chdir);
+
+ eval { chdir(NO_SUCH_FILE); };
+ like ($@, qr/^Can't chdir/, "Lexical fatal chdir");
+
+ no Fatal qw(:lexical chdir);
+
+ eval { chdir(NO_SUCH_FILE); };
+ is ($@, "", "No lexical fatal chdir");
+
+}
+
+eval { chdir(NO_SUCH_FILE); };
+is($@, "", "Lexical chdir becomes non-fatal out of scope.");
+
+eval { Fatal->import('2+2'); };
+like($@,qr{Bad subroutine name},"Can't use fatal with invalid sub names");
diff --git a/lib/autodie/t/lethal.t b/lib/autodie/t/lethal.t
new file mode 100644
index 0000000000..244d2f82b2
--- /dev/null
+++ b/lib/autodie/t/lethal.t
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -w
+use strict;
+use FindBin;
+use Test::More tests => 4;
+use lib "$FindBin::Bin/lib";
+use lethal qw(open);
+
+use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
+
+eval {
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+ok($@, "lethal throws an exception");
+isa_ok($@, 'autodie::exception','...which is the correct class');
+ok($@->matches('open'), "...which matches open");
+is($@->file,__FILE__, "...which reports the correct file");
diff --git a/lib/autodie/t/lib/Caller_helper.pm b/lib/autodie/t/lib/Caller_helper.pm
new file mode 100644
index 0000000000..6ee9c69c07
--- /dev/null
+++ b/lib/autodie/t/lib/Caller_helper.pm
@@ -0,0 +1,13 @@
+package Caller_helper;
+
+our $line;
+
+sub foo {
+ use autodie;
+
+ $line = __LINE__; open(my $fh, '<', "no_such_file_here");
+
+ return;
+}
+
+1;
diff --git a/lib/autodie/t/lib/autodie/test/au.pm b/lib/autodie/t/lib/autodie/test/au.pm
new file mode 100644
index 0000000000..7a50e8f101
--- /dev/null
+++ b/lib/autodie/t/lib/autodie/test/au.pm
@@ -0,0 +1,14 @@
+package autodie::test::au;
+use strict;
+use warnings;
+
+use base qw(autodie);
+
+use autodie::test::au::exception;
+
+sub throw {
+ my ($this, @args) = @_;
+ return autodie::test::au::exception->new(@args);
+}
+
+1;
diff --git a/lib/autodie/t/lib/autodie/test/au/exception.pm b/lib/autodie/t/lib/autodie/test/au/exception.pm
new file mode 100644
index 0000000000..5811fc1ea6
--- /dev/null
+++ b/lib/autodie/t/lib/autodie/test/au/exception.pm
@@ -0,0 +1,19 @@
+package autodie::test::au::exception;
+use strict;
+use warnings;
+
+use base qw(autodie::exception);
+
+sub time_for_a_beer {
+ return "Now's a good time for a beer.";
+}
+
+sub stringify {
+ my ($this) = @_;
+
+ my $base_str = $this->SUPER::stringify;
+
+ return "$base_str\n" . $this->time_for_a_beer;
+}
+
+1;
diff --git a/lib/autodie/t/lib/autodie/test/badname.pm b/lib/autodie/t/lib/autodie/test/badname.pm
new file mode 100644
index 0000000000..2a621a9112
--- /dev/null
+++ b/lib/autodie/t/lib/autodie/test/badname.pm
@@ -0,0 +1,8 @@
+package autodie::test::badname;
+use base qw(autodie);
+
+sub exception_class {
+ return 'autodie::test::badname::$@#%'; # Doesn't exist!
+}
+
+1;
diff --git a/lib/autodie/t/lib/autodie/test/missing.pm b/lib/autodie/t/lib/autodie/test/missing.pm
new file mode 100644
index 0000000000..b6166a53a4
--- /dev/null
+++ b/lib/autodie/t/lib/autodie/test/missing.pm
@@ -0,0 +1,8 @@
+package autodie::test::missing;
+use base qw(autodie);
+
+sub exception_class {
+ return "autodie::test::missing::exception"; # Doesn't exist!
+}
+
+1;
diff --git a/lib/autodie/t/lib/lethal.pm b/lib/autodie/t/lib/lethal.pm
new file mode 100644
index 0000000000..a49600a58a
--- /dev/null
+++ b/lib/autodie/t/lib/lethal.pm
@@ -0,0 +1,8 @@
+package lethal;
+
+# A dummy package showing how we can trivially subclass autodie
+# to our tastes.
+
+use base qw(autodie);
+
+1;
diff --git a/lib/autodie/t/lib/pujHa/ghach.pm b/lib/autodie/t/lib/pujHa/ghach.pm
new file mode 100644
index 0000000000..a55164b1a2
--- /dev/null
+++ b/lib/autodie/t/lib/pujHa/ghach.pm
@@ -0,0 +1,26 @@
+package pujHa'ghach;
+
+# Translator notes: reH Hegh is Kligon for "always dying".
+# It was the original name for this testing pragma, but
+# it lacked an apostrophe, which better shows how Perl is
+# useful in Klingon naming schemes.
+
+# The new name is pujHa'ghach is "thing which is not weak".
+# puj -> be weak (verb)
+# -Ha' -> not
+# ghach -> normalise -Ha' verb into noun.
+#
+# I'm not use if -wI' should be used here. pujwI' is "thing which
+# is weak". One could conceivably use "pujHa'wI'" for "thing which
+# is not weak".
+
+use strict;
+use warnings;
+
+use base qw(autodie);
+
+sub exception_class {
+ return "pujHa'ghach::Dotlh"; # Dotlh - status
+}
+
+1;
diff --git a/lib/autodie/t/lib/pujHa/ghach/Dotlh.pm b/lib/autodie/t/lib/pujHa/ghach/Dotlh.pm
new file mode 100644
index 0000000000..c7bbf8b1f6
--- /dev/null
+++ b/lib/autodie/t/lib/pujHa/ghach/Dotlh.pm
@@ -0,0 +1,59 @@
+package pujHa'ghach::Dotlh;
+
+# Translator notes: Dotlh = status
+
+# Ideally this should be le'wI' - Thing that is exceptional. ;)
+# Unfortunately that results in a file called .pm, which may cause
+# problems on some filesystems.
+
+use strict;
+use warnings;
+
+use base qw(autodie::exception);
+
+sub stringify {
+ my ($this) = @_;
+
+ my $error = $this->SUPER::stringify;
+
+ return "QaghHommeyHeylIjmo':\n" . # Due to your apparent minor errors
+ "$error\n" .
+ "lujqu'"; # Epic fail
+
+
+}
+
+1;
+
+__END__
+
+# The following was a really neat idea, but currently autodie
+# always pushes values in $! to format them, which loses the
+# Klingon translation.
+
+use Errno qw(:POSIX);
+use Scalar::Util qw(dualvar);
+
+my %translation_for = (
+ EPERM() => q{Dachaw'be'}, # You do not have permission
+ ENOENT() => q{De' vItu'laHbe'}, # I cannot find this information.
+);
+
+sub errno {
+ my ($this) = @_;
+
+ my $errno = int $this->SUPER::errno;
+
+ warn "In tlhIngan errno - $errno\n";
+
+ if ( my $tlhIngan = $translation_for{ $errno } ) {
+ return dualvar( $errno, $tlhIngan );
+ }
+
+ return $!;
+
+}
+
+1;
+
+
diff --git a/lib/autodie/t/mkdir.t b/lib/autodie/t/mkdir.t
new file mode 100644
index 0000000000..7bd6529086
--- /dev/null
+++ b/lib/autodie/t/mkdir.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More;
+use FindBin qw($Bin);
+use constant TMPDIR => "$Bin/mkdir_test_delete_me";
+
+# Delete our directory if it's there
+rmdir TMPDIR;
+
+# See if we can create directories and remove them
+mkdir TMPDIR or plan skip_all => "Failed to make test directory";
+
+# Test the directory was created
+-d TMPDIR or plan skip_all => "Failed to make test directory";
+
+# Try making it a second time (this should fail)
+if(mkdir TMPDIR) { plan skip_all => "Attempt to remake a directory succeeded";}
+
+# See if we can remove the directory
+rmdir TMPDIR or plan skip_all => "Failed to remove directory";
+
+# Check that the directory was removed
+if(-d TMPDIR) { plan skip_all => "Failed to delete test directory"; }
+
+# Try to delete second time
+if(rmdir TMPDIR) { plan skip_all => "Able to rmdir directory twice"; }
+
+plan tests => 12;
+
+# Create a directory (this should succeed)
+eval {
+ use autodie;
+
+ mkdir TMPDIR;
+};
+is($@, "", "mkdir returned success");
+ok(-d TMPDIR, "Successfully created test directory");
+
+# Try to create it again (this should fail)
+eval {
+ use autodie;
+
+ mkdir TMPDIR;
+};
+ok($@, "Re-creating directory causes failure.");
+isa_ok($@, "autodie::exception", "... errors are of the correct type");
+ok($@->matches("mkdir"), "... it's also a mkdir object");
+ok($@->matches(":filesys"), "... and a filesys object");
+
+# Try to delete directory (this should succeed)
+eval {
+ use autodie;
+
+ rmdir TMPDIR;
+};
+is($@, "", "rmdir returned success");
+ok(! -d TMPDIR, "Successfully removed test directory");
+
+# Try to delete directory again (this should fail)
+eval {
+ use autodie;
+
+ rmdir TMPDIR;
+};
+ok($@, "Re-deleting directory causes failure.");
+isa_ok($@, "autodie::exception", "... errors are of the correct type");
+ok($@->matches("rmdir"), "... it's also a rmdir object");
+ok($@->matches(":filesys"), "... and a filesys object");
+
diff --git a/lib/autodie/t/open.t b/lib/autodie/t/open.t
new file mode 100644
index 0000000000..3a2d493c49
--- /dev/null
+++ b/lib/autodie/t/open.t
@@ -0,0 +1,18 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More 'no_plan';
+
+use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
+
+use autodie;
+
+eval { open(my $fh, '<', NO_SUCH_FILE); };
+ok($@, "3-arg opening non-existent file fails");
+like($@, qr/for reading/, "Well-formatted 3-arg open failure");
+
+eval { open(my $fh, "< ".NO_SUCH_FILE) };
+ok($@, "2-arg opening non-existent file fails");
+
+like($@, qr/for reading/, "Well-formatted 2-arg open failure");
+unlike($@, qr/GLOB\(0x/, "No ugly globs in 2-arg open messsage");
diff --git a/lib/autodie/t/recv.t b/lib/autodie/t/recv.t
new file mode 100644
index 0000000000..cfaa679144
--- /dev/null
+++ b/lib/autodie/t/recv.t
@@ -0,0 +1,60 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 8;
+use Socket;
+use autodie qw(socketpair);
+
+# All of this code is based around recv returning an empty
+# string when it gets data from a local machine (using AF_UNIX),
+# but returning an undefined value on error. Fatal/autodie
+# should be able to tell the difference.
+
+$SIG{PIPE} = 'IGNORE';
+
+my ($sock1, $sock2);
+socketpair($sock1, $sock2, AF_UNIX, SOCK_STREAM, PF_UNSPEC);
+
+my $buffer;
+send($sock1, "xyz", 0);
+my $ret = recv($sock2, $buffer, 2, 0);
+
+use autodie qw(recv);
+
+SKIP: {
+
+ skip('recv() never returns empty string with socketpair emulation',4)
+ if ($ret);
+
+ is($buffer,'xy',"recv() operational without autodie");
+
+ # Read the last byte from the socket.
+ eval { $ret = recv($sock2, $buffer, 1, 0); };
+
+ is($@, "", "recv should not die on returning an emtpy string.");
+
+ is($buffer,"z","recv() operational with autodie");
+ is($ret,"","recv returns undying empty string for local sockets");
+
+}
+
+eval {
+ # STDIN isn't a socket, so this should fail.
+ recv(STDIN,$buffer,1,0);
+};
+
+ok($@,'recv dies on returning undef');
+isa_ok($@,'autodie::exception');
+
+$buffer = "# Not an empty string\n";
+
+# Terminate writing for $sock1
+shutdown($sock1, 1);
+
+eval {
+ use autodie qw(send);
+ # Writing to a socket terminated for writing should fail.
+ send($sock1,$buffer,0);
+};
+
+ok($@,'send dies on returning undef');
+isa_ok($@,'autodie::exception');
diff --git a/lib/autodie/t/repeat.t b/lib/autodie/t/repeat.t
new file mode 100644
index 0000000000..5f85f1218c
--- /dev/null
+++ b/lib/autodie/t/repeat.t
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More 'no_plan';
+use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
+
+eval {
+ use autodie qw(open open open);
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+isa_ok($@,q{autodie::exception});
+ok($@->matches('open'),"Exception from open");
+
+eval {
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+is($@,"","Repeated autodie should not leak");
+
diff --git a/lib/autodie/t/scope_leak.t b/lib/autodie/t/scope_leak.t
new file mode 100644
index 0000000000..529daa3ecd
--- /dev/null
+++ b/lib/autodie/t/scope_leak.t
@@ -0,0 +1,78 @@
+#!/usr/bin/perl -w
+use strict;
+use FindBin;
+
+# Check for %^H leaking across file boundries. Many thanks
+# to chocolateboy for pointing out this can be a problem.
+
+use lib $FindBin::Bin;
+
+use Test::More 'no_plan';
+
+use constant NO_SUCH_FILE => 'this_file_had_better_not_exist';
+use autodie qw(open);
+
+eval {
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+ok($@, "basic autodie test");
+
+use autodie_test_module;
+
+# If things don't work as they should, then the file we've
+# just loaded will still have an autodying main::open (although
+# its own open should be unaffected).
+
+eval {
+ leak_test(NO_SUCH_FILE);
+};
+
+is($@,"","autodying main::open should not leak to other files");
+
+eval {
+ autodie_test_module::your_open(NO_SUCH_FILE);
+};
+
+is($@,"","Other package open should be unaffected");
+
+# Due to odd filenames reported when doing string evals,
+# older versions of autodie would not propogate into string evals.
+
+eval q{
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+TODO: {
+ local $TODO = "No known way of propagating into string eval in 5.8"
+ if $] < 5.010;
+
+ ok($@, "Failing-open string eval should throw an exception");
+ isa_ok($@, 'autodie::exception');
+}
+
+eval q{
+ no autodie;
+
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+is("$@","","disabling autodie in string context should work");
+
+eval {
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+ok($@,"...but shouldn't disable it for the calling code.");
+isa_ok($@, 'autodie::exception');
+
+eval q{
+ no autodie;
+
+ use autodie qw(open);
+
+ open(my $fh, '<', NO_SUCH_FILE);
+};
+
+ok($@,"Wacky flipping of autodie in string eval should work too!");
+isa_ok($@, 'autodie::exception');
diff --git a/lib/autodie/t/sysopen.t b/lib/autodie/t/sysopen.t
new file mode 100644
index 0000000000..ab489b7830
--- /dev/null
+++ b/lib/autodie/t/sysopen.t
@@ -0,0 +1,23 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More 'no_plan';
+use Fcntl;
+
+use autodie qw(sysopen);
+
+use constant NO_SUCH_FILE => "this_file_had_better_not_be_here_at_all";
+
+my $fh;
+eval {
+ sysopen($fh, $0, O_RDONLY);
+};
+
+is($@, "", "sysopen can open files that exist");
+
+like(scalar( <$fh> ), qr/perl/, "Data in file read");
+
+eval {
+ sysopen(my $fh2, NO_SUCH_FILE, O_RDONLY);
+};
+
+isa_ok($@, 'autodie::exception', 'Opening a bad file fails with sysopen');
diff --git a/lib/autodie/t/truncate.t b/lib/autodie/t/truncate.t
new file mode 100644
index 0000000000..e69ee32d2e
--- /dev/null
+++ b/lib/autodie/t/truncate.t
@@ -0,0 +1,53 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More;
+use File::Temp qw(tempfile);
+use IO::Handle;
+
+my $tmpfh = tempfile();
+my $truncate_status;
+
+eval {
+ $truncate_status = truncate($tmpfh, 0);
+};
+
+if ($@ || !defined($truncate_status)) {
+ plan skip_all => 'Truncate not implemented or not working on this system';
+}
+
+plan tests => 3;
+
+SKIP: {
+ my $can_truncate_stdout = truncate(\*STDOUT,0);
+
+ if ($can_truncate_stdout) {
+ skip("This system thinks we can truncate STDOUT. Suuure!", 1);
+ }
+
+ eval {
+ use autodie;
+ truncate(\*STDOUT,0);
+ };
+
+ isa_ok($@, 'autodie::exception', "Truncating STDOUT should throw an exception");
+
+}
+
+eval {
+ use autodie;
+ no warnings 'once';
+ truncate(\*FOO, 0);
+};
+
+isa_ok($@, 'autodie::exception', "Truncating an unopened file is wrong.");
+
+$tmpfh->print("Hello World");
+$tmpfh->flush;
+
+eval {
+ use autodie;
+ truncate($tmpfh, 0);
+};
+
+is($@, "", "Truncating a normal file should be fine");
diff --git a/lib/autodie/t/unlink.t b/lib/autodie/t/unlink.t
new file mode 100644
index 0000000000..f301500fda
--- /dev/null
+++ b/lib/autodie/t/unlink.t
@@ -0,0 +1,52 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More;
+use FindBin qw($Bin);
+use constant TMPFILE => "$Bin/unlink_test_delete_me";
+
+# Create a file to practice unlinking
+open(my $fh, ">", TMPFILE)
+ or plan skip_all => "Unable to create test file: $!";
+print {$fh} "Test\n";
+close $fh;
+
+# Check that file now exists
+-e TMPFILE or plan skip_all => "Failed to create test file";
+
+# Check we can unlink
+unlink TMPFILE;
+
+# Check it's gone
+if(-e TMPFILE) {plan skip_all => "Failed to delete test file: $!";}
+
+# Re-create file
+open(my $fh2, ">", TMPFILE)
+ or plan skip_all => "Unable to create test file: $!";
+print {$fh2} "Test\n";
+close $fh2;
+
+# Check that file now exists
+-e TMPFILE or plan skip_all => "Failed to create test file";
+
+plan tests => 6;
+
+# Try to delete directory (this should succeed)
+eval {
+ use autodie;
+
+ unlink TMPFILE;
+};
+is($@, "", "Unlink appears to have been successful");
+ok(! -e TMPFILE, "File does not exist");
+
+# Try to delete file again (this should fail)
+eval {
+ use autodie;
+
+ unlink TMPFILE;
+};
+ok($@, "Re-unlinking file causes failure.");
+isa_ok($@, "autodie::exception", "... errors are of the correct type");
+ok($@->matches("unlink"), "... it's also a unlink object");
+ok($@->matches(":filesys"), "... and a filesys object");
+
diff --git a/lib/autodie/t/user-context.t b/lib/autodie/t/user-context.t
new file mode 100644
index 0000000000..96a0390fa0
--- /dev/null
+++ b/lib/autodie/t/user-context.t
@@ -0,0 +1,59 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use Test::More 'no_plan';
+use File::Copy;
+use constant NO_SUCH_FILE => 'this_file_had_better_not_exist';
+use constant EXCEPTION => 'autodie::exception';
+
+# http://perlmonks.org/?node_id=744246 describes a situation where
+# using autodie on user-defined functions can fail, depending upon
+# their context. These tests attempt to detect this bug.
+
+eval {
+ use autodie qw(copy);
+ copy(NO_SUCH_FILE, 'xyzzy');
+};
+
+isa_ok($@,EXCEPTION,"Copying a non-existent file should throw an error");
+
+eval {
+ use autodie qw(copy);
+ my $x = copy(NO_SUCH_FILE, 'xyzzy');
+};
+
+isa_ok($@,EXCEPTION,"This shouldn't change with scalar context");
+
+eval {
+ use autodie qw(copy);
+ my @x = copy(NO_SUCH_FILE, 'xyzzy');
+};
+
+TODO: {
+ local $TODO = "Fixed in 'hints' branch";
+
+ isa_ok($@,EXCEPTION,"This shouldn't change with array context");
+}
+
+# For good measure, test with built-ins.
+
+eval {
+ use autodie qw(open);
+ open(my $fh, '<', 'xyzzy');
+};
+
+isa_ok($@,EXCEPTION,"Opening a non-existent file should throw an error");
+
+eval {
+ use autodie qw(open);
+ my $x = open(my $fh, '<', 'xyzzy');
+};
+
+isa_ok($@,EXCEPTION,"This shouldn't change with scalar context");
+
+eval {
+ use autodie qw(open);
+ my @x = open(my $fh, '<', 'xyzzy');
+};
+
+isa_ok($@,EXCEPTION,"This shouldn't change with array context");
diff --git a/lib/autodie/t/usersub.t b/lib/autodie/t/usersub.t
new file mode 100644
index 0000000000..7e15576abf
--- /dev/null
+++ b/lib/autodie/t/usersub.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More 'no_plan';
+
+sub mytest {
+ return $_[0];
+}
+
+is(mytest(q{foo}),q{foo},"Mytest returns input");
+
+my $return = eval { mytest(undef); };
+
+ok(!defined($return), "mytest returns undef without autodie");
+is($@,"","Mytest doesn't throw an exception without autodie");
+
+$return = eval {
+ use autodie qw(mytest);
+
+ mytest('foo');
+};
+
+is($return,'foo',"Mytest returns input with autodie");
+
+$return = eval {
+ use autodie qw(mytest);
+
+ mytest(undef);
+};
+
+isa_ok($@,'autodie::exception',"autodie mytest/undef throws exception");
+
+# We set initial values here because we're expecting $data to be
+# changed to undef later on. Having it as undef to begin with means
+# we can't see mytest(undef) working correctly.
+
+my ($data, $data2) = (1,1);
+
+eval {
+ use autodie qw(mytest);
+
+ {
+ no autodie qw(mytest);
+
+ $data = mytest(undef);
+ $data2 = mytest('foo');
+ }
+};
+
+is($@,"","no autodie can counter use autodie for user subs");
+ok(!defined($data), "mytest(undef) should return undef");
+is($data2, "foo", "mytest(foo) should return foo");
+
+eval {
+ mytest(undef);
+};
+
+is($@,"","No lingering failure effects");
+
+$return = eval {
+ mytest("bar");
+};
+
+is($return,"bar","No lingering return effects");
diff --git a/lib/autodie/t/version.t b/lib/autodie/t/version.t
new file mode 100644
index 0000000000..7a68f7f0fc
--- /dev/null
+++ b/lib/autodie/t/version.t
@@ -0,0 +1,17 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 3;
+
+# For the moment, we'd like all our versions to be the same.
+# In order to play nicely with some code scanners, they need to be
+# hard-coded into the files, rather than just nicking the version
+# from autodie::exception at run-time.
+
+require Fatal;
+require autodie;
+require autodie::exception;
+require autodie::exception::system;
+
+is($Fatal::VERSION, $autodie::VERSION);
+is($autodie::VERSION, $autodie::exception::VERSION);
+is($autodie::exception::VERSION, $autodie::exception::system::VERSION);
diff --git a/lib/autodie/t/version_tag.t b/lib/autodie/t/version_tag.t
new file mode 100644
index 0000000000..7cb533329e
--- /dev/null
+++ b/lib/autodie/t/version_tag.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+eval {
+ use autodie qw(:1.994);
+
+ open(my $fh, '<', 'this_file_had_better_not_exist.txt');
+};
+
+isa_ok($@, 'autodie::exception', "Basic version tags work");
+
+
+# Expanding :1.00 should fail, there was no autodie :1.00
+eval { my $foo = autodie->_expand_tag(":1.00"); };
+
+isnt($@,"","Expanding :1.00 should fail");
+
+my $version = $autodie::VERSION;
+
+# Expanding our current version should work!
+eval { my $foo = autodie->_expand_tag(":$version"); };
+
+is($@,"","Expanding :$version should succeed");
+