diff options
author | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2009-05-14 15:06:08 +0200 |
---|---|---|
committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2009-05-14 15:06:08 +0200 |
commit | 8024b5df24675d60f6262988f448e15a0d1f5af0 (patch) | |
tree | b04d5e4f9945f3d0309ae0314c1607ab77c4cbde /lib | |
parent | 233b59f5c897689b9082b1c3a2b12d17f71582c4 (diff) | |
download | perl-8024b5df24675d60f6262988f448e15a0d1f5af0.tar.gz |
Move autodie tests in lib/autodie/t, so they are picked up by t/harness
Diffstat (limited to 'lib')
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"); + |