use constant MIN_IPC_SYS_SIMPLE_VER => 0.12;
# All the Fatal/autodie modules share the same version number.
-our $VERSION = '1.998';
+our $VERSION = '1.999';
our $Debug ||= 0;
':1.996' => [qw(:default)],
':1.997' => [qw(:default)],
':1.998' => [qw(:default)],
+ ':1.999' => [qw(:default)],
);
$call = 'CORE::system';
$name = 'system';
+ $core = 1;
} elsif ($name eq 'exec') {
# Exec doesn't have a prototype. We don't care. This
sub$real_proto {
+ # If we're inside a string eval, we can end up with a
+ # whacky filename. The following code allows autodie
+ # to propagate correctly into string evals.
+
+ my \$caller_level = 0;
+
+ while ( (caller \$caller_level)[1] =~ m{^\\(eval \\d+\\)\$} ) {
+ \$caller_level++;
+ }
+
# If we're called from the correct file, then use the
# autodying code.
- goto &\$code if ((caller)[1] eq \$filename);
+ goto &\$code if ((caller \$caller_level)[1] eq \$filename);
# Oh bother, we've leaked into another file. Call the
# original code. Note that \$sref may actually be a
our $VERSION;
BEGIN {
- $VERSION = "1.998";
+ $VERSION = "1.999";
}
use constant ERROR_WRONG_FATAL => q{
is used with package filehandles (eg, C<FILE>). It's strongly recommended
you use scalar filehandles instead.
+Under Perl 5.8 only, C<autodie> I<does not> propagate into string C<eval>
+statements, although it can be explicitly enabled inside a string
+C<eval>. This bug does not affect block C<eval> statements in
+any version of Perl.
+
When using C<autodie> or C<Fatal> with user subroutines, the
declaration of those subroutines must appear before the first use of
C<Fatal> or C<autodie>, or have been exported from a module.
use if ($] >= 5.010), overload => '~~' => "matches";
-our $VERSION = '1.998';
+our $VERSION = '1.999';
my $PACKAGE = __PACKAGE__; # Useful to have a scalar for hash keys.
}
+ # We now have everything correct, *except* for our subroutine
+ # name. If it's __ANON__ or (eval), then we need to keep on
+ # digging deeper into our stack to find the real name. However we
+ # don't update our other information, since that will be correct
+ # for our current exception.
+
+ my $first_guess_subroutine = $sub;
+
+ while (defined $sub and $sub =~ /^\(eval\)$|::__ANON__$/) {
+ $depth++;
+
+ $sub = (CORE::caller($depth))[3];
+ }
+
+ # If we end up falling out the bottom of our stack, then our
+ # __ANON__ guess is the best we can get. This includes situations
+ # where we were called from thetop level of a program.
+
+ if (not defined $sub) {
+ $sub = $first_guess_subroutine;
+ }
+
$this->{$PACKAGE}{package} = $package;
$this->{$PACKAGE}{file} = $file;
$this->{$PACKAGE}{line} = $line;
use base 'autodie::exception';
use Carp qw(croak);
-our $VERSION = '1.998';
+our $VERSION = '1.999';
my $PACKAGE = __PACKAGE__;
=head1 SYNOPSIS
eval {
- use autodie;
+ use autodie qw(system);
system($cmd, @args);
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 13;
+use Test::More tests => 17;
use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
+my $line;
+
eval {
use autodie ':io';
- open(my $fh, '<', NO_SUCH_FILE);
+ $line = __LINE__; open(my $fh, '<', NO_SUCH_FILE);
};
like($@, qr/Can't open '\w+' for reading: /, "Prety printed open msg");
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");
--- /dev/null
+#!/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");
--- /dev/null
+package Caller_helper;
+
+our $line;
+
+sub foo {
+ use autodie;
+
+ $line = __LINE__; open(my $fh, '<', "no_such_file_here");
+
+ return;
+}
+
+1;
};
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');
--- /dev/null
+#!/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");
projects / p5sagit/p5-mst-13.2.git / commitdiff