From: Jesse Luehrs <doy@tozt.net>
Date: Sun, 19 Sep 2010 01:18:20 +0000 (-0500)
Subject: Revert "revert the vivication changes for now, i didn't mean to release them"
X-Git-Tag: 0.09~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5d3589c862fc8593a95ac572b8eb20e97a593a0c;p=gitmo%2FPackage-Stash.git

Revert "revert the vivication changes for now, i didn't mean to release them"

This reverts commit 44726d1abdc534e4ac6ddfc6d91d245c8dc0ebc7.
---

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;