1*b39c5158Smillert#!/usr/bin/perl -w 2*b39c5158Smillertuse strict; 3*b39c5158Smillertuse warnings; 4*b39c5158Smillertuse Test::More 'no_plan'; 5*b39c5158Smillertuse File::Copy; 6*b39c5158Smillertuse constant NO_SUCH_FILE => 'this_file_had_better_not_exist'; 7*b39c5158Smillertuse constant EXCEPTION => 'autodie::exception'; 8*b39c5158Smillert 9*b39c5158Smillert# http://perlmonks.org/?node_id=744246 describes a situation where 10*b39c5158Smillert# using autodie on user-defined functions can fail, depending upon 11*b39c5158Smillert# their context. These tests attempt to detect this bug. 12*b39c5158Smillert 13*b39c5158Smillerteval { 14*b39c5158Smillert use autodie qw(copy); 15*b39c5158Smillert copy(NO_SUCH_FILE, 'xyzzy'); 16*b39c5158Smillert}; 17*b39c5158Smillert 18*b39c5158Smillertisa_ok($@,EXCEPTION,"Copying a non-existent file should throw an error"); 19*b39c5158Smillert 20*b39c5158Smillerteval { 21*b39c5158Smillert use autodie qw(copy); 22*b39c5158Smillert my $x = copy(NO_SUCH_FILE, 'xyzzy'); 23*b39c5158Smillert}; 24*b39c5158Smillert 25*b39c5158Smillertisa_ok($@,EXCEPTION,"This shouldn't change with scalar context"); 26*b39c5158Smillert 27*b39c5158Smillerteval { 28*b39c5158Smillert use autodie qw(copy); 29*b39c5158Smillert my @x = copy(NO_SUCH_FILE, 'xyzzy'); 30*b39c5158Smillert}; 31*b39c5158Smillert 32*b39c5158Smillertisa_ok($@,EXCEPTION,"This shouldn't change with array context"); 33*b39c5158Smillert 34*b39c5158Smillert# For good measure, test with built-ins. 35*b39c5158Smillert 36*b39c5158Smillerteval { 37*b39c5158Smillert use autodie qw(open); 38*b39c5158Smillert open(my $fh, '<', 'xyzzy'); 39*b39c5158Smillert}; 40*b39c5158Smillert 41*b39c5158Smillertisa_ok($@,EXCEPTION,"Opening a non-existent file should throw an error"); 42*b39c5158Smillert 43*b39c5158Smillerteval { 44*b39c5158Smillert use autodie qw(open); 45*b39c5158Smillert my $x = open(my $fh, '<', 'xyzzy'); 46*b39c5158Smillert}; 47*b39c5158Smillert 48*b39c5158Smillertisa_ok($@,EXCEPTION,"This shouldn't change with scalar context"); 49*b39c5158Smillert 50*b39c5158Smillerteval { 51*b39c5158Smillert use autodie qw(open); 52*b39c5158Smillert my @x = open(my $fh, '<', 'xyzzy'); 53*b39c5158Smillert}; 54*b39c5158Smillert 55*b39c5158Smillertisa_ok($@,EXCEPTION,"This shouldn't change with array context"); 56