xref: /openbsd/gnu/usr.bin/perl/cpan/autodie/t/autodie.t (revision 898184e3) 
1#!/usr/bin/perl -w
2use strict;
3
4use constant NO_SUCH_FILE => 'this_file_had_so_better_not_be_here';
5
6use Test::More tests => 19;
7
8{
9
10    use autodie qw(open);
11
12    eval { open(my $fh, '<', NO_SUCH_FILE); };
13    like($@,qr{Can't open},"autodie qw(open) in lexical scope");
14
15    no autodie qw(open);
16
17    eval { open(my $fh, '<', NO_SUCH_FILE); };
18    is($@,"","no autodie qw(open) in lexical scope");
19
20    use autodie qw(open);
21    eval { open(my $fh, '<', NO_SUCH_FILE); };
22    like($@,qr{Can't open},"autodie qw(open) in lexical scope 2");
23
24    no autodie; # Should turn off all autodying subs
25    eval { open(my $fh, '<', NO_SUCH_FILE); };
26    is($@,"","no autodie in lexical scope 2");
27
28    # Turn our pragma on one last time, so we can verify that
29    # falling out of this block reverts it back to previous
30    # behaviour.
31    use autodie qw(open);
32    eval { open(my $fh, '<', NO_SUCH_FILE); };
33    like($@,qr{Can't open},"autodie qw(open) in lexical scope 3");
34
35}
36
37eval { open(my $fh, '<', NO_SUCH_FILE); };
38is($@,"","autodie open outside of lexical scope");
39
40eval {
41    use autodie;	# Should turn on everything
42    open(my $fh, '<', NO_SUCH_FILE);
43};
44
45like($@, qr{Can't open}, "vanilla use autodie turns on everything.");
46
47eval { open(my $fh, '<', NO_SUCH_FILE); };
48is($@,"","vanilla autodie cleans up");
49
50{
51    use autodie qw(:io);
52
53    eval { open(my $fh, '<', NO_SUCH_FILE); };
54    like($@,qr{Can't open},"autodie q(:io) makes autodying open");
55
56    no autodie qw(:io);
57
58    eval { open(my $fh, '<', NO_SUCH_FILE); };
59    is($@,"", "no autodie qw(:io) disabled autodying open");
60}
61
62{
63    package Testing_autodie;
64
65    use Test::More;
66
67    use constant NO_SUCH_FILE => ::NO_SUCH_FILE();
68
69    use Fatal qw(open);
70
71    eval { open(my $fh, '<', NO_SUCH_FILE); };
72
73    like($@, qr{Can't open}, "Package fatal working");
74    is(ref $@,"","Old Fatal throws strings");
75
76    {
77        use autodie qw(open);
78
79        ok(1,"use autodie allowed with Fatal");
80
81        eval { open(my $fh, '<', NO_SUCH_FILE); };
82        like($@, qr{Can't open}, "autodie and Fatal works");
83        isa_ok($@, "autodie::exception"); # autodie throws real exceptions
84
85    }
86
87    eval { open(my $fh, '<', NO_SUCH_FILE); };
88
89    like($@, qr{Can't open}, "Package fatal working after autodie");
90    is(ref $@,"","Old Fatal throws strings after autodie");
91
92    eval " no autodie qw(open); ";
93
94    ok($@,"no autodie on Fataled sub an error.");
95
96    eval "
97        no autodie qw(close);
98        use Fatal 'close';
99    ";
100
101    like($@, qr{not allowed}, "Using fatal after autodie is an error.");
102}
103
104