From 5d3589c862fc8593a95ac572b8eb20e97a593a0c Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Sat, 18 Sep 2010 20:18:20 -0500 Subject: Revert "revert the vivication changes for now, i didn't mean to release them" This reverts commit 44726d1abdc534e4ac6ddfc6d91d245c8dc0ebc7. --- lib/Package/Stash.pm | 35 +++++++---- t/04-get.t | 160 ++++++++++++++++++++++++++++++++++++++++++++++----- t/05-isa.t | 2 +- 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", + "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", + "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; -- cgit v1.2.3-54-g00ecf