1#!/usr/bin/perl -w
2use strict;
3use FindBin;
4
5# Check for %^H leaking across file boundries.  Many thanks
6# to chocolateboy for pointing out this can be a problem.
7
8use lib $FindBin::Bin;
9
10use Test::More 'no_plan';
11
12use constant NO_SUCH_FILE  => 'this_file_had_better_not_exist';
13use constant NO_SUCH_FILE2 => 'this_file_had_better_not_exist_either';
14use autodie qw(open rename);
15
16eval { open(my $fh, '<', NO_SUCH_FILE); };
17ok($@, "basic autodie test - open");
18
19eval { rename(NO_SUCH_FILE, NO_SUCH_FILE2); };
20ok($@, "basic autodie test - rename");
21
22use autodie_test_module;
23
24# If things don't work as they should, then the file we've
25# just loaded will still have an autodying main::open (although
26# its own open should be unaffected).
27
28eval { leak_test(NO_SUCH_FILE); };
29is($@,"","autodying main::open should not leak to other files");
30
31eval { autodie_test_module::your_open(NO_SUCH_FILE); };
32is($@,"","Other package open should be unaffected");
33
34# The same should apply for rename (which is different, because
35# it doesn't depend upon packages, and could be cached more
36# aggressively.)
37
38eval { leak_test_rename(NO_SUCH_FILE, NO_SUCH_FILE2); };
39is($@,"","autodying main::rename should not leak to other files");
40
41eval { autodie_test_module::your_rename(NO_SUCH_FILE, NO_SUCH_FILE2); };
42is($@,"","Other package rename should be unaffected");
43
44# Dying rename in the other package should still die.
45eval { autodie_test_module::your_dying_rename(NO_SUCH_FILE, NO_SUCH_FILE2); };
46ok($@, "rename in loaded module should remain autodying.");
47
48# Due to odd filenames reported when doing string evals,
49# older versions of autodie would not propogate into string evals.
50
51eval q{
52    open(my $fh, '<', NO_SUCH_FILE);
53};
54
55TODO: {
56    local $TODO = "No known way of propagating into string eval in 5.8"
57        if $] < 5.010;
58
59    ok($@, "Failing-open string eval should throw an exception");
60    isa_ok($@, 'autodie::exception');
61}
62
63eval q{
64    no autodie;
65
66    open(my $fh, '<', NO_SUCH_FILE);
67};
68
69is("$@","","disabling autodie in string context should work");
70
71eval {
72    open(my $fh, '<', NO_SUCH_FILE);
73};
74
75ok($@,"...but shouldn't disable it for the calling code.");
76isa_ok($@, 'autodie::exception');
77
78eval q{
79    no autodie;
80
81    use autodie qw(open);
82
83    open(my $fh, '<', NO_SUCH_FILE);
84};
85
86ok($@,"Wacky flipping of autodie in string eval should work too!");
87isa_ok($@, 'autodie::exception');
88
89eval q{
90    # RT#72053
91    use autodie;
92    { no autodie; }
93    open(my $fh, '<', NO_SUCH_FILE);
94};
95
96ok($@,"Wacky flipping of autodie in string eval should work too!");
97isa_ok($@, 'autodie::exception');
98