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 use Scalar::Util;
   8
   9 {
  10     BEGIN {
  11         my $stash = Package::Stash->new('Hash');
  12         my $val = $stash->get_symbol('%foo');
  13         is($val, undef, "got nothing yet");
  14     }
  15     {
  16         no warnings 'void', 'once';
  17         %Hash::foo;
  18     }
  19     BEGIN {
  20         my $stash = Package::Stash->new('Hash');
  21         my $val = $stash->get_symbol('%foo');
  22         is(ref($val), 'HASH', "got something");
  23         $val->{bar} = 1;
  24         is_deeply($stash->get_symbol('%foo'), {bar => 1},
  25                   "got the right variable");
  26         is_deeply(\%Hash::foo, {bar => 1},
  27                   "stash has the right variable");
  28     }
  29 }
  30
  31 {
  32     BEGIN {
  33         my $stash = Package::Stash->new('Array');
  34         my $val = $stash->get_symbol('@foo');
  35         is($val, undef, "got nothing yet");
  36     }
  37     {
  38         no warnings 'void', 'once';
  39         @Array::foo;
  40     }
  41     BEGIN {
  42         my $stash = Package::Stash->new('Array');
  43         my $val = $stash->get_symbol('@foo');
  44         is(ref($val), 'ARRAY', "got something");
  45         push @$val, 1;
  46         is_deeply($stash->get_symbol('@foo'), [1],
  47                   "got the right variable");
  48         is_deeply(\@Array::foo, [1],
  49                   "stash has the right variable");
  50     }
  51 }
  52
  53 {
  54     BEGIN {
  55         my $stash = Package::Stash->new('Scalar');
  56         my $val = $stash->get_symbol('$foo');
  57         is($val, undef, "got nothing yet");
  58     }
  59     {
  60         no warnings 'void', 'once';
  61         $Scalar::foo;
  62     }
  63     BEGIN {
  64         my $stash = Package::Stash->new('Scalar');
  65         my $val = $stash->get_symbol('$foo');
  66         is(ref($val), 'SCALAR', "got something");
  67         $$val = 1;
  68         is_deeply($stash->get_symbol('$foo'), \1,
  69                   "got the right variable");
  70         is($Scalar::foo, 1,
  71            "stash has the right variable");
  72     }
  73 }
  74
  75 {
  76     BEGIN {
  77         my $stash = Package::Stash->new('Code');
  78         my $val = $stash->get_symbol('&foo');
  79         is($val, undef, "got nothing yet");
  80     }
  81     {
  82         no warnings 'void', 'once';
  83         sub Code::foo { }
  84     }
  85     BEGIN {
  86         my $stash = Package::Stash->new('Code');
  87         my $val = $stash->get_symbol('&foo');
  88         is(ref($val), 'CODE', "got something");
  89         is(prototype($val), undef, "got the right variable");
  90         &Scalar::Util::set_prototype($val, '&');
  91         is($stash->get_symbol('&foo'), $val,
  92            "got the right variable");
  93         is(prototype($stash->get_symbol('&foo')), '&',
  94            "got the right variable");
  95         is(prototype(\&Code::foo), '&',
  96            "stash has the right variable");
  97     }
  98 }
  99
 100 {
 101     BEGIN {
 102         my $stash = Package::Stash->new('Io');
 103         my $val = $stash->get_symbol('FOO');
 104         is($val, undef, "got nothing yet");
 105     }
 106     {
 107         no warnings 'void', 'once';
 108         package Io;
 109         fileno(FOO);
 110     }
 111     BEGIN {
 112         my $stash = Package::Stash->new('Io');
 113         my $val = $stash->get_symbol('FOO');
 114         isa_ok($val, 'IO');
 115         my $str = "foo";
 116         open $val, '<', \$str;
 117         is(readline($stash->get_symbol('FOO')), "foo",
 118            "got the right variable");
 119         seek($stash->get_symbol('FOO'), 0, 0);
 120         {
 121             package Io;
 122             ::isa_ok(*FOO{IO}, 'IO');
 123             ::is(<FOO>, "foo",
 124                  "stash has the right variable");
 125         }
 126     }
 127 }
 128
 129 {
 130     my $stash = Package::Stash->new('Hash::Vivify');
 131     my $val = $stash->get_or_add_symbol('%foo');
 132     is(ref($val), 'HASH', "got something");
 133     $val->{bar} = 1;
 134     is_deeply($stash->get_or_add_symbol('%foo'), {bar => 1},
 135               "got the right variable");
 136     no warnings 'once';
 137     is_deeply(\%Hash::Vivify::foo, {bar => 1},
 138               "stash has the right variable");
 139 }
 140
 141 {
 142     my $stash = Package::Stash->new('Array::Vivify');
 143     my $val = $stash->get_or_add_symbol('@foo');
 144     is(ref($val), 'ARRAY', "got something");
 145     push @$val, 1;
 146     is_deeply($stash->get_or_add_symbol('@foo'), [1],
 147               "got the right variable");
 148     no warnings 'once';
 149     is_deeply(\@Array::Vivify::foo, [1],
 150               "stash has the right variable");
 151 }
 152
 153 {
 154     my $stash = Package::Stash->new('Scalar::Vivify');
 155     my $val = $stash->get_or_add_symbol('$foo');
 156     is(ref($val), 'SCALAR', "got something");
 157     $$val = 1;
 158     is_deeply($stash->get_or_add_symbol('$foo'), \1,
 159               "got the right variable");
 160     no warnings 'once';
 161     is($Scalar::Vivify::foo, 1,
 162        "stash has the right variable");
 163 }
 164
 165 {
 166     BEGIN {
 167         my $stash = Package::Stash->new('Io::Vivify');
 168         my $val = $stash->get_or_add_symbol('FOO');
 169         isa_ok($val, 'IO');
 170         my $str = "foo";
 171         open $val, '<', \$str;
 172         is(readline($stash->get_symbol('FOO')), "foo",
 173            "got the right variable");
 174         seek($stash->get_symbol('FOO'), 0, 0);
 175     }
 176     {
 177         package Io::Vivify;
 178         no warnings 'once';
 179         ::isa_ok(*FOO{IO}, 'IO');
 180         ::is(<FOO>, "foo",
 181              "stash has the right variable");
 182     }
 183 }
 184
 185 done_testing;