use Carp qw(confess);
use Scalar::Util qw(reftype);
-use Symbol;
-# before 5.12, assigning to the ISA glob would make it lose its magical ->isa
-# powers
-use constant BROKEN_ISA_ASSIGNMENT => ($] < 5.012);
=head1 SYNOPSIS
my $namespace = $self->namespace;
if (!exists $namespace->{$name}) {
- if ($opts{vivify}) {
- if ($type eq 'ARRAY') {
- if (BROKEN_ISA_ASSIGNMENT) {
- $self->add_package_symbol(
- $variable,
- $name eq 'ISA' ? () : ([])
- );
- }
- else {
- $self->add_package_symbol($variable, []);
- }
- }
- elsif ($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') {
- confess "Don't know how to vivify CODE variables";
- }
- else {
- confess "Unknown type $type in vivication";
- }
+ # 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 ($opts{vivify} && $type eq 'HASH') {
+ $self->add_package_symbol($variable, {});
}
else {
- if ($type eq 'CODE') {
- # this effectively "de-vivifies" the code slot. if we don't do
- # this, referencing the coderef at the end of this function
- # will cause perl to auto-vivify a stub coderef in the slot,
- # which isn't what we want
- $self->add_package_symbol($variable);
- }
+ # 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");
- }
-}
-
-{
- BEGIN {
- my $stash = Package::Stash->new('Code');
- my $val = $stash->get_package_symbol('&foo');
- is($val, undef, "got nothing yet");
- }
- {
- no warnings 'void', 'once';
- sub Code::foo { }
- }
- BEGIN {
- my $stash = Package::Stash->new('Code');
- my $val = $stash->get_package_symbol('&foo');
- is(ref($val), 'CODE', "got something");
- is(prototype($val), undef, "got the right variable");
- &Scalar::Util::set_prototype($val, '&');
- is($stash->get_package_symbol('&foo'), $val,
- "got the right variable");
- is(prototype($stash->get_package_symbol('&foo')), '&',
- "got the right variable");
- is(prototype(\&Code::foo), '&',
- "stash has 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");
- }
+ "got the right variable");
}
}
{
- 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;