t/04-get.t

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