1use strict; 2use warnings; 3use lib 't/lib'; 4use Test::More; 5 6use Package::Stash; 7use 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 185done_testing; 186