summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2010-10-31 10:41:56 -0500
committerJesse Luehrs <doy@tozt.net>2010-10-31 10:56:09 -0500
commit67b1704808e62f27210fe992df9c45b232fe9d5b (patch)
tree19e2f7a922593fa69f3e81a5a41293e0bb86a091
parent23093e2990bf64f03ad844e7b08fffa34ead8510 (diff)
downloadpackage-stash-67b1704808e62f27210fe992df9c45b232fe9d5b.tar.gz
package-stash-67b1704808e62f27210fe992df9c45b232fe9d5b.zip
revert vivication changes for now again0.13
-rw-r--r--Changes2
-rw-r--r--inc/MMPackageStash.pm4
-rw-r--r--lib/Package/Stash.pm51
-rw-r--r--t/04-get.t144
-rw-r--r--t/05-isa.t2
5 files changed, 31 insertions, 172 deletions
diff --git a/Changes b/Changes
index 12aa030..965b8d0 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
Revision history for Package-Stash
{{$NEXT}}
+ - revert the vivification changes for now, to get an actual release out
+ with Test::Fatal
0.12-TRIAL 2010-10-27
- actually include the conflict stuff in the release (bah)
diff --git a/inc/MMPackageStash.pm b/inc/MMPackageStash.pm
index 93c04e4..cab44dc 100644
--- a/inc/MMPackageStash.pm
+++ b/inc/MMPackageStash.pm
@@ -14,8 +14,8 @@ around _build_MakeFile_PL_template => sub {
$template .= <<'CHECK_CONFLICTS';
sub check_conflicts {
my %conflicts = (
- 'Class::MOP' => '1.08',
- 'MooseX::Role::WithOverloading' => '0.08',
+ # 'Class::MOP' => '1.08',
+ # 'MooseX::Role::WithOverloading' => '0.08',
);
my $found = 0;
for my $mod ( sort keys %conflicts ) {
diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index 6c361c1..32e5d30 100644
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -5,10 +5,6 @@ use warnings;
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
@@ -234,42 +230,21 @@ sub get_package_symbol {
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)
}
}
diff --git a/t/04-get.t b/t/04-get.t
index 3c4ae43..ebeb864 100644
--- a/t/04-get.t
+++ b/t/04-get.t
@@ -7,178 +7,60 @@ use Package::Stash;
{
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;
diff --git a/t/05-isa.t b/t/05-isa.t
index 0b41b72..3198fb1 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_or_add_package_symbol('@ISA')} = @ISA;
+@{$stash->get_package_symbol('@ISA')} = @ISA;
isa_ok('Foo', 'Bar');
done_testing;