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('Code');
  77         my $val = $stash->get_package_symbol('&foo');
  78         is($val, undef, "got nothing yet");
  79     }
  80     {
  81         no warnings 'void', 'once';
  82         sub Code::foo { }
  83     }
  84     BEGIN {
  85         my $stash = Package::Stash->new('Code');
  86         my $val = $stash->get_package_symbol('&foo');
  87         is(ref($val), 'CODE', "got something");
  88         is(prototype($val), undef, "got the right variable");
  89         &Scalar::Util::set_prototype($val, '&');
  90         is($stash->get_package_symbol('&foo'), $val,
  91            "got the right variable");
  92         is(prototype($stash->get_package_symbol('&foo')), '&',
  93            "got the right variable");
  94         is(prototype(\&Code::foo), '&',
  95            "stash has the right variable");
  96     }
  97 }
  98
  99 {
 100     BEGIN {
 101         my $stash = Package::Stash->new('Io');
 102         my $val = $stash->get_package_symbol('FOO');
 103         is($val, undef, "got nothing yet");
 104     }
 105     {
 106         no warnings 'void', 'once';
 107         package Io;
 108         fileno(FOO);
 109     }
 110     BEGIN {
 111         my $stash = Package::Stash->new('Io');
 112         my $val = $stash->get_package_symbol('FOO');
 113         isa_ok($val, 'IO');
 114         my $str = "foo";
 115         open $val, '<', \$str;
 116         is(readline($stash->get_package_symbol('FOO')), "foo",
 117            "got the right variable");
 118         seek($stash->get_package_symbol('FOO'), 0, 0);
 119         {
 120             package Io;
 121             ::isa_ok(*FOO{IO}, 'IO');
 122             ::is(<FOO>, "foo",
 123                  "stash has the right variable");
 124         }
 125     }
 126 }
 127
 128 {
 129     my $stash = Package::Stash->new('Hash::Vivify');
 130     my $val = $stash->get_or_add_package_symbol('%foo');
 131     is(ref($val), 'HASH', "got something");
 132     $val->{bar} = 1;
 133     is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1},
 134               "got the right variable");
 135     no warnings 'once';
 136     is_deeply(\%Hash::Vivify::foo, {bar => 1},
 137               "stash has the right variable");
 138 }
 139
 140 {
 141     my $stash = Package::Stash->new('Array::Vivify');
 142     my $val = $stash->get_or_add_package_symbol('@foo');
 143     is(ref($val), 'ARRAY', "got something");
 144     push @$val, 1;
 145     is_deeply($stash->get_or_add_package_symbol('@foo'), [1],
 146               "got the right variable");
 147     no warnings 'once';
 148     is_deeply(\@Array::Vivify::foo, [1],
 149               "stash has the right variable");
 150 }
 151
 152 {
 153     my $stash = Package::Stash->new('Scalar::Vivify');
 154     my $val = $stash->get_or_add_package_symbol('$foo');
 155     is(ref($val), 'SCALAR', "got something");
 156     $$val = 1;
 157     is_deeply($stash->get_or_add_package_symbol('$foo'), \1,
 158               "got the right variable");
 159     no warnings 'once';
 160     is($Scalar::Vivify::foo, 1,
 161        "stash has the right variable");
 162 }
 163
 164 {
 165     BEGIN {
 166         my $stash = Package::Stash->new('Io::Vivify');
 167         my $val = $stash->get_or_add_package_symbol('FOO');
 168         isa_ok($val, 'IO');
 169         my $str = "foo";
 170         open $val, '<', \$str;
 171         is(readline($stash->get_package_symbol('FOO')), "foo",
 172            "got the right variable");
 173         seek($stash->get_package_symbol('FOO'), 0, 0);
 174     }
 175     {
 176         package Io::Vivify;
 177         no warnings 'once';
 178         ::isa_ok(*FOO{IO}, 'IO');
 179         ::is(<FOO>, "foo",
 180              "stash has the right variable");
 181     }
 182 }
 183
 184 done_testing;