1b39c5158Smillert#!/usr/bin/perl -w 2b39c5158Smillertuse strict; 3b39c5158Smillert 4*5486feefSafresh1use Test::More tests => 24; 5b39c5158Smillert 6b39c5158Smillertuse constant NO_SUCH_FILE => "this_file_had_better_not_exist"; 7b39c5158Smillert 8b39c5158Smillertmy $line; 9b39c5158Smillert 10b39c5158Smillerteval { 11b39c5158Smillert use autodie ':io'; 12b39c5158Smillert $line = __LINE__; open(my $fh, '<', NO_SUCH_FILE); 13b39c5158Smillert}; 14b39c5158Smillert 15b39c5158Smillertlike($@, qr/Can't open '\w+' for reading: /, "Prety printed open msg"); 16b39c5158Smillertlike($@, qr{\Q$0\E}, "Our file mention in error message"); 17b39c5158Smillert 18b39c5158Smillertlike($@, qr{for reading: '.+'}, "Error should be in single-quotes"); 19b39c5158Smillertlike($@->errno,qr/./, "Errno should not be empty"); 20b39c5158Smillert 21b39c5158Smillertlike($@, qr{\n$}, "Errors should end with a newline"); 22b39c5158Smillertis($@->file, $0, "Correct file"); 23b39c5158Smillertis($@->function, 'CORE::open', "Correct dying sub"); 24b39c5158Smillertis($@->package, __PACKAGE__, "Correct package"); 25b39c5158Smillertis($@->caller,__PACKAGE__."::__ANON__", "Correct caller"); 26b39c5158Smillertis($@->line, $line, "Correct line"); 27b39c5158Smillertis($@->args->[1], '<', 'Correct mode arg'); 28b39c5158Smillertis($@->args->[2], NO_SUCH_FILE, 'Correct filename arg'); 29b39c5158Smillertok($@->matches('open'), 'Looks like an error from open'); 30b39c5158Smillertok($@->matches(':io'), 'Looks like an error from :io'); 31b39c5158Smillertis($@->context, 'scalar', 'Open called in scalar/void context'); 32b39c5158Smillertis($@->return,undef,'Open should return undef on failure'); 33b39c5158Smillert 34b39c5158Smillert# Testing of caller info with a real subroutine. 35b39c5158Smillert 36b39c5158Smillertmy $line2; 37b39c5158Smillert 38b39c5158Smillertsub xyzzy { 39b39c5158Smillert use autodie ':io'; 40b39c5158Smillert $line2 = __LINE__; open(my $fh, '<', NO_SUCH_FILE); 41b39c5158Smillert return; 42b39c5158Smillert}; 43b39c5158Smillert 44b39c5158Smillerteval { xyzzy(); }; 45b39c5158Smillert 46b39c5158Smillertisa_ok($@, 'autodie::exception'); 47b39c5158Smillertis($@->caller, __PACKAGE__."::xyzzy", "Subroutine caller test"); 48b39c5158Smillertis($@->line, $line2, "Subroutine line test"); 49*5486feefSafresh1 50*5486feefSafresh1eval { 51*5486feefSafresh1 no warnings 'once'; # To prevent the following close from complaining. 52*5486feefSafresh1 close(THIS_FILEHANDLE_AINT_OPEN); 53*5486feefSafresh1}; 54*5486feefSafresh1 55*5486feefSafresh1ok(! $@, "Close without autodie should fail silent"); 56*5486feefSafresh1 57*5486feefSafresh1eval { 58*5486feefSafresh1 use autodie ':io'; 59*5486feefSafresh1 close(THIS_FILEHANDLE_AINT_OPEN); 60*5486feefSafresh1}; 61*5486feefSafresh1 62*5486feefSafresh1like($@, qr{Can't close filehandle 'THIS_FILEHANDLE_AINT_OPEN'},"Nice msg from close"); 63*5486feefSafresh1 64*5486feefSafresh1ok($@, 'boolean overload works'); 65*5486feefSafresh1ok $@ eq $@.'', "string overloading is complete (eq)"; 66*5486feefSafresh1ok( ($@ cmp $@.'') == 0, "string overloading is complete (cmp)" ); 67