cpan/autodie/t/scope_leak.t

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