From 67b1704808e62f27210fe992df9c45b232fe9d5b Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Sun, 31 Oct 2010 10:41:56 -0500 Subject: revert vivication changes for now again --- Changes | 2 + inc/MMPackageStash.pm | 4 +- lib/Package/Stash.pm | 51 +++++------------- t/04-get.t | 144 +++++--------------------------------------------- t/05-isa.t | 2 +- 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", - "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", - "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; -- cgit v1.2.3-54-g00ecf