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         {
  94             package Io;
  95             ::isa_ok(*FOO{IO}, 'IO');
  96         }
  97     }
  98 }
  99
 100 TODO: {
 101     # making TODO tests at a mixture of BEGIN and runtime is irritating
 102     my $_TODO;
 103     BEGIN { $_TODO = "obviously I don't understand this well enough"; }
 104     BEGIN { $TODO = $_TODO; }
 105     $TODO = $_TODO;
 106     BEGIN {
 107         my $stash = Package::Stash->new('Code');
 108         my $val = $stash->get_package_symbol('&foo');
 109         is($val, undef, "got nothing yet");
 110     }
 111     {
 112         no warnings 'void', 'once';
 113         \&Code::foo;
 114     }
 115     BEGIN {
 116         my $stash = Package::Stash->new('Code');
 117         my $val = $stash->get_package_symbol('&foo');
 118         undef $TODO;
 119         is(ref($val), 'CODE', "got something");
 120         $TODO = $_TODO;
 121         SKIP: {
 122             eval "require PadWalker"
 123                 or skip "needs PadWalker", 1;
 124             # avoid padwalker segfault
 125             if (!defined($val)) {
 126                 fail("got the right variable");
 127             }
 128             else {
 129                 PadWalker::set_closed_over($val, {'$x' => 1});
 130                 is_deeply({PadWalker::closed_over($stash->get_package_symbol('&foo'))}, {'$x' => 1},
 131                           "got the right variable");
 132                 is_deeply({PadWalker::closed_over(\&Code::foo)}, {'$x' => 1},
 133                           "stash has the right variable");
 134             }
 135         }
 136     }
 137     BEGIN { undef $TODO; }
 138     undef $TODO;
 139 }
 140
 141 {
 142     my $stash = Package::Stash->new('Hash::Vivify');
 143     my $val = $stash->get_or_add_package_symbol('%foo');
 144     is(ref($val), 'HASH', "got something");
 145     $val->{bar} = 1;
 146     is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1},
 147               "got the right variable");
 148     no warnings 'once';
 149     is_deeply(\%Hash::Vivify::foo, {bar => 1},
 150               "stash has the right variable");
 151 }
 152
 153 {
 154     my $stash = Package::Stash->new('Array::Vivify');
 155     my $val = $stash->get_or_add_package_symbol('@foo');
 156     is(ref($val), 'ARRAY', "got something");
 157     push @$val, 1;
 158     is_deeply($stash->get_or_add_package_symbol('@foo'), [1],
 159               "got the right variable");
 160     no warnings 'once';
 161     is_deeply(\@Array::Vivify::foo, [1],
 162               "stash has the right variable");
 163 }
 164
 165 {
 166     my $stash = Package::Stash->new('Scalar::Vivify');
 167     my $val = $stash->get_or_add_package_symbol('$foo');
 168     is(ref($val), 'SCALAR', "got something");
 169     $$val = 1;
 170     is_deeply($stash->get_or_add_package_symbol('$foo'), \1,
 171               "got the right variable");
 172     no warnings 'once';
 173     is($Scalar::Vivify::foo, 1,
 174        "stash has the right variable");
 175 }
 176
 177 {
 178     BEGIN {
 179         my $stash = Package::Stash->new('Io::Vivify');
 180         my $val = $stash->get_or_add_package_symbol('FOO');
 181         isa_ok($val, 'IO');
 182         my $str = "foo";
 183         open $val, '<', \$str;
 184         is(readline($stash->get_package_symbol('FOO')), "foo",
 185            "got the right variable");
 186     }
 187     {
 188         package Io::Vivify;
 189         no warnings 'once';
 190         ::isa_ok(*FOO{IO}, 'IO');
 191     }
 192 }
 193
 194 done_testing;