use Carp qw(confess);
use Scalar::Util qw(reftype);
-use Symbol;
=head1 SYNOPSIS
my $namespace = $self->namespace;
- if ($opts{vivify} && !exists $namespace->{$name}) {
- if ($type eq 'ARRAY') {
- $self->add_package_symbol(
- $variable,
- # setting our own arrayref manually loses the magicalness or
- # something
- $name eq 'ISA' ? () : ([])
- );
+ if (!exists $namespace->{$name}) {
+ # assigning to the result of this function like
+ # @{$stash->get_package_symbol('@ISA')} = @new_ISA
+ # makes the result not visible until the variable is explicitly
+ # accessed... in the case of @ISA, this might never happen
+ # for instance, assigning like that and then calling $obj->isa
+ # will fail. see t/005-isa.t
+ if ($opts{vivify} && $type eq 'ARRAY' && $name ne 'ISA') {
+ $self->add_package_symbol($variable, []);
}
- elsif ($type eq 'HASH') {
+ elsif ($opts{vivify} && $type eq 'HASH') {
$self->add_package_symbol($variable, {});
}
- elsif ($type eq 'SCALAR') {
- $self->add_package_symbol($variable);
- }
- elsif ($type eq 'IO') {
- $self->add_package_symbol($variable, Symbol::geniosym);
- }
- elsif ($type eq 'CODE') {
- # ignoring this case for now, since i don't know what would
- # be useful to do here (and subs in the stash autovivify in weird
- # ways too)
- #$self->add_package_symbol($variable, sub {});
- }
else {
- confess "Unknown type $type in vivication";
+ # FIXME
+ $self->add_package_symbol($variable)
}
}
{
BEGIN {
- my $stash = Package::Stash->new('Hash');
+ my $stash = Package::Stash->new('Foo');
my $val = $stash->get_package_symbol('%foo');
is($val, undef, "got nothing yet");
}
{
no warnings 'void', 'once';
- %Hash::foo;
+ %Foo::foo;
}
BEGIN {
- my $stash = Package::Stash->new('Hash');
+ my $stash = Package::Stash->new('Foo');
my $val = $stash->get_package_symbol('%foo');
is(ref($val), 'HASH', "got something");
$val->{bar} = 1;
is_deeply($stash->get_package_symbol('%foo'), {bar => 1},
- "got the right variable");
- is_deeply(\%Hash::foo, {bar => 1},
- "stash has the right variable");
+ "got the right variable");
}
}
{
BEGIN {
- my $stash = Package::Stash->new('Array');
+ my $stash = Package::Stash->new('Bar');
my $val = $stash->get_package_symbol('@foo');
- is($val, undef, "got nothing yet");
+ is($val, undef, "got something");
}
{
no warnings 'void', 'once';
- @Array::foo;
+ @Bar::foo;
}
BEGIN {
- my $stash = Package::Stash->new('Array');
+ my $stash = Package::Stash->new('Bar');
my $val = $stash->get_package_symbol('@foo');
is(ref($val), 'ARRAY', "got something");
push @$val, 1;
is_deeply($stash->get_package_symbol('@foo'), [1],
- "got the right variable");
- is_deeply(\@Array::foo, [1],
- "stash has the right variable");
- }
-}
-
-{
- BEGIN {
- my $stash = Package::Stash->new('Scalar');
- my $val = $stash->get_package_symbol('$foo');
- is($val, undef, "got nothing yet");
- }
- {
- no warnings 'void', 'once';
- $Scalar::foo;
- }
- BEGIN {
- my $stash = Package::Stash->new('Scalar');
- my $val = $stash->get_package_symbol('$foo');
- is(ref($val), 'SCALAR', "got something");
- $$val = 1;
- is_deeply($stash->get_package_symbol('$foo'), \1,
- "got the right variable");
- is($Scalar::foo, 1,
- "stash has the right variable");
+ "got the right variable");
}
}
{
- BEGIN {
- my $stash = Package::Stash->new('Io');
- my $val = $stash->get_package_symbol('FOO');
- is($val, undef, "got nothing yet");
- }
- {
- no warnings 'void', 'once';
- package Io;
- fileno(FOO);
- }
- BEGIN {
- my $stash = Package::Stash->new('Io');
- my $val = $stash->get_package_symbol('FOO');
- isa_ok($val, 'IO');
- my $str = "foo";
- open $val, '<', \$str;
- is(readline($stash->get_package_symbol('FOO')), "foo",
- "got the right variable");
- seek($stash->get_package_symbol('FOO'), 0, 0);
- {
- package Io;
- ::isa_ok(*FOO{IO}, 'IO');
- ::is(<FOO>, "foo",
- "stash has the right variable");
- }
- }
-}
-
-TODO: {
- # making TODO tests at a mixture of BEGIN and runtime is irritating
- my $_TODO;
- BEGIN { $_TODO = "obviously I don't understand this well enough"; }
- BEGIN { $TODO = $_TODO; }
- $TODO = $_TODO;
- BEGIN {
- my $stash = Package::Stash->new('Code');
- my $val = $stash->get_package_symbol('&foo');
- is($val, undef, "got nothing yet");
- }
- {
- no warnings 'void', 'once';
- \&Code::foo;
- }
- BEGIN {
- my $stash = Package::Stash->new('Code');
- my $val = $stash->get_package_symbol('&foo');
- undef $TODO;
- is(ref($val), 'CODE', "got something");
- $TODO = $_TODO;
- SKIP: {
- eval "require PadWalker"
- or skip "needs PadWalker", 1;
- # avoid padwalker segfault
- if (!defined($val)) {
- fail("got the right variable");
- }
- else {
- PadWalker::set_closed_over($val, {'$x' => 1});
- is_deeply({PadWalker::closed_over($stash->get_package_symbol('&foo'))}, {'$x' => 1},
- "got the right variable");
- is_deeply({PadWalker::closed_over(\&Code::foo)}, {'$x' => 1},
- "stash has the right variable");
- }
- }
- }
- BEGIN { undef $TODO; }
- undef $TODO;
-}
-
-{
- my $stash = Package::Stash->new('Hash::Vivify');
+ my $stash = Package::Stash->new('Baz');
my $val = $stash->get_or_add_package_symbol('%foo');
is(ref($val), 'HASH', "got something");
$val->{bar} = 1;
is_deeply($stash->get_or_add_package_symbol('%foo'), {bar => 1},
- "got the right variable");
- no warnings 'once';
- is_deeply(\%Hash::Vivify::foo, {bar => 1},
- "stash has the right variable");
+ "got the right variable");
}
{
- my $stash = Package::Stash->new('Array::Vivify');
+ my $stash = Package::Stash->new('Quux');
my $val = $stash->get_or_add_package_symbol('@foo');
is(ref($val), 'ARRAY', "got something");
push @$val, 1;
is_deeply($stash->get_or_add_package_symbol('@foo'), [1],
- "got the right variable");
- no warnings 'once';
- is_deeply(\@Array::Vivify::foo, [1],
- "stash has the right variable");
-}
-
-{
- my $stash = Package::Stash->new('Scalar::Vivify');
- my $val = $stash->get_or_add_package_symbol('$foo');
- is(ref($val), 'SCALAR', "got something");
- $$val = 1;
- is_deeply($stash->get_or_add_package_symbol('$foo'), \1,
- "got the right variable");
- no warnings 'once';
- is($Scalar::Vivify::foo, 1,
- "stash has the right variable");
-}
-
-{
- BEGIN {
- my $stash = Package::Stash->new('Io::Vivify');
- my $val = $stash->get_or_add_package_symbol('FOO');
- isa_ok($val, 'IO');
- my $str = "foo";
- open $val, '<', \$str;
- is(readline($stash->get_package_symbol('FOO')), "foo",
- "got the right variable");
- seek($stash->get_package_symbol('FOO'), 0, 0);
- }
- {
- package Io::Vivify;
- no warnings 'once';
- ::isa_ok(*FOO{IO}, 'IO');
- ::is(<FOO>, "foo",
- "stash has the right variable");
- }
+ "got the right variable");
}
done_testing;