xref: /openbsd-src/gnu/usr.bin/perl/cpan/autodie/t/user-context.t (revision b39c515898423c8d899e35282f4b395f7cad3298)
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