t/04-get.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5
   6 use Package::Stash;
   7
   8 {
   9     BEGIN {
  10         my $stash = Package::Stash->new('Hash');
  11         my $val = $stash->get_package_symbol('%foo');
  12         is($val, undef, "got nothing yet");
  13     }
  14     {
  15         no warnings 'void', 'once';
  16         %Hash::foo;
  17     }
  18     BEGIN {
  19         my $stash = Package::Stash->new('Hash');
  20         my $val = $stash->get_package_symbol('%foo');
  21         is(ref($val), 'HASH', "got something");
  22         $val->{bar} = 1;
  23         is_deeply($stash->get_package_symbol('%foo'), {bar => 1},
  24                   "got the right variable");
  25         is_deeply(\%Hash::foo, {bar => 1},
  26                   "stash has the right variable");
  27     }
  28 }
  29
  30 {
  31     BEGIN {
  32         my $stash = Package::Stash->new('Array');
  33         my $val = $stash->get_package_symbol('@foo');
  34         is($val, undef, "got nothing yet");
  35     }
  36     {
  37         no warnings 'void', 'once';
  38         @Array::foo;
  39     }
  40     BEGIN {
  41         my $stash = Package::Stash->new('Array');
  42         my $val = $stash->get_package_symbol('@foo');
  43         is(ref($val), 'ARRAY', "got something");
  44         push @$val, 1;
  45         is_deeply($stash->get_package_symbol('@foo'), [1],
  46                   "got the right variable");
  47         is_deeply(\@Array::foo, [1],
  48                   "stash has the right variable");
  49     }
  50 }
  51
  52 {
  53     BEGIN {
  54         my $stash = Package::Stash->new('Scalar');
  55         my $val = $stash->get_package_symbol('$foo');
  56         is($val, undef, "got nothing yet");
  57     }
  58     {
  59         no warnings 'void', 'once';
  60         $Scalar::foo;
  61     }
  62     BEGIN {
  63         my $stash = Package::Stash->new('Scalar');
  64         my $val = $stash->get_package_symbol('$foo');
  65         is(ref($val), 'SCALAR', "got something");
  66         $$val = 1;
  67         is_deeply($stash->get_package_symbol('$foo'), \1,
  68                   "got the right variable");
  69         is($Scalar::foo, 1,
  70            "stash has the right variable");
  71     }
  72 }
  73
  74 {
  75     BEGIN {
  76         my $stash = Package::Stash->new('Io');
  77         my $val = $stash->get_package_symbol('FOO');
  78         is($val, undef, "got nothing yet");
  79     }
  80     {
  81         no warnings 'void', 'once';
  82         package Io;
  83         fileno(FOO);
  84     }
  85     BEGIN {
  86         my $stash = Package::Stash->new('Io');
  87         my $val = $stash->get_package_symbol('FOO');
  88         isa_ok($val, 'IO');
  89         my $str = "foo";
  90         open $val, '<', \$str;
  91         is(readline($stash->get_package_symbol('FOO')), "foo",
  92            "got the right variable");
  93         seek($stash->get_package_symbol('FOO'), 0, 0);
  94         {
  95             package Io;
  96             ::isa_ok(*FOO{IO}, 'IO');
  97             ::is(<FOO>, "foo",
  98                  "stash has the right variable");
  99         }
 100     }
 101 }
 102
 103 TODO: {
 104     # making TODO tests at a mixture of BEGIN and runtime is irritating
 105     my $_TODO;
 106     BEGIN { $_TODO = "obviously I don't understand this well enough"; }
 107     BEGIN { $TODO = $_TODO; }
 108     $TODO = $_TODO;
 109     BEGIN {
 110         my $stash = Package::Stash->new('Code');
 111         my $val = $stash->get_package_symbol('&foo');
 112         is($val, undef, "got nothing yet");
 113     }
 114     {
 115         no warnings 'void', 'once';
 116         \&Code::foo;
 117     }
 118     BEGIN {
 119         my $stash = Package::Stash->new('Code');
 120         my $val = $stash->get_package_symbol('&foo');
 121         undef $TODO;
 122         is(ref($val), 'CODE', "got something");
 123         $TODO = $_TODO;
 124         SKIP: {
 125             eval "require PadWalker"
 126                 or skip "needs PadWalker", 1;
 127             # avoid padwalker segfault
 128             if (!defined($val)) {
 129                 fail("got the right variable");
 130             }
 131             else {
 132                 PadWalker::set_closed_over($val, {'$x' => 1});
 133                 is_deeply({PadWalker::closed_over($stash->get_package_symbol('&foo'))}, {'$x' => 1},
 134                           "got the right variable");
 135                 is_deeply({PadWalker::closed_over(\&Code::foo)}, {'$x' => 1},
 136                           "stash has the right variable");
 137             }
 138         }
 139     }
 140     BEGIN { undef $TODO; }
 141     undef $TODO;
 142 }
 143
 144 {
 145     my $stash = Package::Stash->new('Hash::Vivify');
 146     my $val = $stash->get_or_add_package_symbol('%foo');
 147     is(ref($val), 'HASH', "got something");
 148     $val->{bar} = 1;
 149     is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1},
 150               "got the right variable");
 151     no warnings 'once';
 152     is_deeply(\%Hash::Vivify::foo, {bar => 1},
 153               "stash has the right variable");
 154 }
 155
 156 {
 157     my $stash = Package::Stash->new('Array::Vivify');
 158     my $val = $stash->get_or_add_package_symbol('@foo');
 159     is(ref($val), 'ARRAY', "got something");
 160     push @$val, 1;
 161     is_deeply($stash->get_or_add_package_symbol('@foo'), [1],
 162               "got the right variable");
 163     no warnings 'once';
 164     is_deeply(\@Array::Vivify::foo, [1],
 165               "stash has the right variable");
 166 }
 167
 168 {
 169     my $stash = Package::Stash->new('Scalar::Vivify');
 170     my $val = $stash->get_or_add_package_symbol('$foo');
 171     is(ref($val), 'SCALAR', "got something");
 172     $$val = 1;
 173     is_deeply($stash->get_or_add_package_symbol('$foo'), \1,
 174               "got the right variable");
 175     no warnings 'once';
 176     is($Scalar::Vivify::foo, 1,
 177        "stash has the right variable");
 178 }
 179
 180 {
 181     BEGIN {
 182         my $stash = Package::Stash->new('Io::Vivify');
 183         my $val = $stash->get_or_add_package_symbol('FOO');
 184         isa_ok($val, 'IO');
 185         my $str = "foo";
 186         open $val, '<', \$str;
 187         is(readline($stash->get_package_symbol('FOO')), "foo",
 188            "got the right variable");
 189         seek($stash->get_package_symbol('FOO'), 0, 0);
 190     }
 191     {
 192         package Io::Vivify;
 193         no warnings 'once';
 194         ::isa_ok(*FOO{IO}, 'IO');
 195         ::is(<FOO>, "foo",
 196              "stash has the right variable");
 197     }
 198 }
 199
 200 done_testing;