summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-09-18 20:18:20 -0500
committerJesse Luehrs <doy@tozt.net>2010-09-18 20:18:20 -0500
commit5d3589c862fc8593a95ac572b8eb20e97a593a0c (patch)
tree69ca8cd9b3658c235951d840c11c0da6299a897a
parent759031e2653d734955eb57cf8fbac9e1ef8af3e3 (diff)
downloadpackage-stash-5d3589c862fc8593a95ac572b8eb20e97a593a0c.tar.gz
package-stash-5d3589c862fc8593a95ac572b8eb20e97a593a0c.zip
Revert "revert the vivication changes for now, i didn't mean to release them"
This reverts commit 44726d1abdc534e4ac6ddfc6d91d245c8dc0ebc7.
-rw-r--r--lib/Package/Stash.pm35
-rw-r--r--t/04-get.t160
-rw-r--r--t/05-isa.t2
3 files changed, 171 insertions, 26 deletions
diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index 32e5d30..77236d0 100644
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -5,6 +5,7 @@ use warnings;
use Carp qw(confess);
use Scalar::Util qw(reftype);
+use Symbol;
=head1 SYNOPSIS
@@ -229,22 +230,32 @@ sub get_package_symbol {
my $namespace = $self->namespace;
- 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, []);
+ 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' ? () : ([])
+ );
}
- elsif ($opts{vivify} && $type eq 'HASH') {
+ 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') {
+ # 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 {
- # FIXME
- $self->add_package_symbol($variable)
+ confess "Unknown type $type in vivication";
}
}
diff --git a/t/04-get.t b/t/04-get.t
index ebeb864..3176ed1 100644
--- a/t/04-get.t
+++ b/t/04-get.t
@@ -7,60 +7,194 @@ use Package::Stash;
{
BEGIN {
- my $stash = Package::Stash->new('Foo');
+ my $stash = Package::Stash->new('Hash');
my $val = $stash->get_package_symbol('%foo');
is($val, undef, "got nothing yet");
}
{
no warnings 'void', 'once';
- %Foo::foo;
+ %Hash::foo;
}
BEGIN {
- my $stash = Package::Stash->new('Foo');
+ my $stash = Package::Stash->new('Hash');
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");
+ "got the right variable");
+ is_deeply(\%Hash::foo, {bar => 1},
+ "stash has the right variable");
}
}
{
BEGIN {
- my $stash = Package::Stash->new('Bar');
+ my $stash = Package::Stash->new('Array');
my $val = $stash->get_package_symbol('@foo');
- is($val, undef, "got something");
+ is($val, undef, "got nothing yet");
}
{
no warnings 'void', 'once';
- @Bar::foo;
+ @Array::foo;
}
BEGIN {
- my $stash = Package::Stash->new('Bar');
+ my $stash = Package::Stash->new('Array');
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");
+ "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");
}
}
{
- my $stash = Package::Stash->new('Baz');
+ 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 $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");
+ "got the right variable");
+ no warnings 'once';
+ is_deeply(\%Hash::Vivify::foo, {bar => 1},
+ "stash has the right variable");
}
{
- my $stash = Package::Stash->new('Quux');
+ my $stash = Package::Stash->new('Array::Vivify');
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");
+ "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");
+ }
}
done_testing;
diff --git a/t/05-isa.t b/t/05-isa.t
index 3198fb1..0b41b72 100644
--- a/t/05-isa.t
+++ b/t/05-isa.t
@@ -15,7 +15,7 @@ use Package::Stash;
my $stash = Package::Stash->new('Foo');
my @ISA = ('Bar');
-@{$stash->get_package_symbol('@ISA')} = @ISA;
+@{$stash->get_or_add_package_symbol('@ISA')} = @ISA;
isa_ok('Foo', 'Bar');
done_testing;