cpan/autodie/t/basic_exceptions.t

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 use Test::More tests => 19;
   5
   6 use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
   7
   8 my $line;
   9
  10 eval {
  11         use autodie ':io';
  12         $line = __LINE__; open(my $fh, '<', NO_SUCH_FILE);
  13 };
  14
  15 like($@, qr/Can't open '\w+' for reading: /, "Prety printed open msg");
  16 like($@, qr{\Q$0\E}, "Our file mention in error message");
  17
  18 like($@, qr{for reading: '.+'}, "Error should be in single-quotes");
  19 like($@->errno,qr/./, "Errno should not be empty");
  20
  21 like($@, qr{\n$}, "Errors should end with a newline");
  22 is($@->file, $0, "Correct file");
  23 is($@->function, 'CORE::open', "Correct dying sub");
  24 is($@->package, __PACKAGE__, "Correct package");
  25 is($@->caller,__PACKAGE__."::__ANON__", "Correct caller");
  26 is($@->line, $line, "Correct line");
  27 is($@->args->[1], '<', 'Correct mode arg');
  28 is($@->args->[2], NO_SUCH_FILE, 'Correct filename arg');
  29 ok($@->matches('open'), 'Looks like an error from open');
  30 ok($@->matches(':io'),  'Looks like an error from :io');
  31 is($@->context, 'scalar', 'Open called in scalar/void context');
  32 is($@->return,undef,'Open should return undef on failure');
  33
  34 # Testing of caller info with a real subroutine.
  35
  36 my $line2;
  37
  38 sub xyzzy {
  39     use autodie ':io';
  40     $line2 = __LINE__; open(my $fh, '<', NO_SUCH_FILE);
  41     return;
  42 };
  43
  44 eval { xyzzy(); };
  45
  46 isa_ok($@, 'autodie::exception');
  47 is($@->caller, __PACKAGE__."::xyzzy", "Subroutine caller test");
  48 is($@->line, $line2, "Subroutine line test");