lib/autodie/t/hints_pod_examples.t

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use warnings;
   4 use autodie::hints;
   5 use Test::More;
   6
   7 use constant PERL510 => ( $] >= 5.010 );
   8
   9 BEGIN {
  10     if (not PERL510) {
  11         plan skip_all => "Only subroutine hints supported in 5.8.x";
  12     }
  13     else {
  14         plan 'no_plan';
  15     }
  16 }
  17
  18 use FindBin;
  19 use lib "$FindBin::Bin/lib";
  20 use Hints_pod_examples qw(
  21         undef_scalar false_scalar zero_scalar empty_list default_list
  22         empty_or_false_list undef_n_error_list foo re_fail bar
  23         think_positive my_system
  24 );
  25 use autodie qw( !
  26         undef_scalar false_scalar zero_scalar empty_list default_list
  27         empty_or_false_list undef_n_error_list foo re_fail bar
  28         think_positive my_system
  29 );
  30
  31 my %scalar_tests = (
  32
  33     # Test code             # Exception expected?
  34
  35     'undef_scalar()'        => 1,
  36     'undef_scalar(1)',      => 0,
  37     'undef_scalar(0)',      => 0,
  38     'undef_scalar("")',     => 0,
  39
  40     'false_scalar(0)',      => 1,
  41     'false_scalar()',       => 1,
  42     'false_scalar(undef)',  => 1,
  43     'false_scalar("")',     => 1,
  44     'false_scalar(1)',      => 0,
  45     'false_scalar("1")',    => 0,
  46
  47     'zero_scalar("0")',     => 1,
  48     'zero_scalar(0)',       => 1,
  49     'zero_scalar(1)',       => 0,
  50     'zero_scalar(undef)',   => 0,
  51     'zero_scalar("")',      => 0,
  52
  53     'foo(0)',               => 1,
  54     'foo(undef)',           => 0,
  55     'foo(1)',               => 0,
  56
  57     'bar(0)',               => 1,
  58     'bar(undef)',           => 0,
  59     'bar(1)',               => 0,
  60
  61     're_fail(-1)',          => 0,
  62     're_fail("FAIL")',      => 1,
  63     're_fail("_FAIL")',     => 1,
  64     're_fail("_fail")',     => 0,
  65     're_fail("fail")',      => 0,
  66
  67     'think_positive(-1)'    => 1,
  68     'think_positive(-2)'    => 1,
  69     'think_positive(0)'     => 0,
  70     'think_positive(1)'     => 0,
  71     'think_positive(2)'     => 0,
  72
  73     'my_system(1)'          => 1,
  74     'my_system(2)'          => 1,
  75     'my_system(0)'          => 0,
  76
  77 );
  78
  79 my %list_tests = (
  80
  81     'empty_list()',         => 1,
  82     'empty_list(())',       => 1,
  83     'empty_list([])',       => 0,
  84     'empty_list(0)',        => 0,
  85     'empty_list("")',       => 0,
  86     'empty_list(undef)',    => 0,
  87
  88     'default_list()',       => 1,
  89     'default_list(0)',      => 0,
  90     'default_list("")',     => 0,
  91     'default_list(undef)',  => 1,
  92     'default_list(1)',      => 0,
  93     'default_list("str")',  => 0,
  94     'default_list(1, 2)',   => 0,
  95
  96     'empty_or_false_list()',     => 1,
  97     'empty_or_false_list(())',   => 1,
  98     'empty_or_false_list(0)',    => 1,
  99     'empty_or_false_list(undef)',=> 1,
 100     'empty_or_false_list("")',   => 1,
 101     'empty_or_false_list("0")',  => 1,
 102     'empty_or_false_list(1,2)',  => 0,
 103     'empty_or_false_list("a")',  => 0,
 104
 105     'undef_n_error_list(undef, 1)'   => 1,
 106     'undef_n_error_list(undef, "a")' => 1,
 107     'undef_n_error_list()'           => 0,
 108     'undef_n_error_list(0, 1)'       => 0,
 109     'undef_n_error_list("", 1)'      => 0,
 110     'undef_n_error_list(1)'          => 0,
 111
 112     'foo(0)',               => 1,
 113     'foo(undef)',           => 0,
 114     'foo(1)',               => 0,
 115
 116     'bar(0)',               => 1,
 117     'bar(undef)',           => 0,
 118     'bar(1)',               => 0,
 119
 120     're_fail(-1)',          => 1,
 121     're_fail("FAIL")',      => 0,
 122     're_fail("_FAIL")',     => 0,
 123     're_fail("_fail")',     => 0,
 124     're_fail("fail")',      => 0,
 125
 126     'think_positive(-1)'    => 1,
 127     'think_positive(-2)'    => 1,
 128     'think_positive(0)'     => 0,
 129     'think_positive(1)'     => 0,
 130     'think_positive(2)'     => 0,
 131
 132     'my_system(1)'          => 1,
 133     'my_system(2)'          => 1,
 134     'my_system(0)'          => 0,
 135
 136 );
 137
 138 # On Perl 5.8, autodie doesn't correctly propagate into string evals.
 139 # The following snippet forces the use of autodie inside the eval if
 140 # we really really have to.  For 5.10+, we don't want to include this
 141 # fix, because the tests will act as a canary if we screw up string
 142 # eval propagation.
 143
 144 my $perl58_fix = (
 145     PERL510 ?
 146     q{} :
 147     q{use autodie qw(
 148         undef_scalar false_scalar zero_scalar empty_list default_list
 149         empty_or_false_list undef_n_error_list foo re_fail bar
 150         think_positive my_system bizarro_system
 151     );}
 152 );
 153
 154 # Some of the tests provide different hints for scalar or list context
 155
 156 while (my ($test, $exception_expected) = each %scalar_tests) {
 157     eval "
 158         $perl58_fix
 159         my \$scalar = $test;
 160     ";
 161
 162     if ($exception_expected) {
 163         isnt("$@", "", "scalar test - $test");
 164     }
 165     else {
 166         is($@, "", "scalar test - $test");
 167     }
 168 }
 169
 170 while (my ($test, $exception_expected) = each %list_tests) {
 171     eval "
 172         $perl58_fix
 173         my \@array = $test;
 174     ";
 175
 176     if ($exception_expected) {
 177         isnt("$@", "", "array test - $test");
 178     }
 179     else {
 180         is($@, "", "array test - $test");
 181     }
 182 }
 183
 184 1;