better test for scalar existence

7 files changed, 38 insertions, 25 deletions

diff --git a/Changes b/Changes
index 7f9d95e..c45f4a6 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
 Revision history for Package-Stash
 
 {{$NEXT}}
+      - bring the behavior of has_symbol for nonexistant scalars into line with
+        the xs version
 
 0.31  2011-08-08
       - fix ->add_symbol('$foo', qr/sdlfk/) on 5.12+
diff --git a/lib/Package/Stash.pm b/lib/Package/Stash.pm
index 3a79c2c..532a85d 100644
--- a/lib/Package/Stash.pm
+++ b/lib/Package/Stash.pm
@@ -197,6 +197,11 @@ to the variable names (basically, a clone of the stash).
 
 =over 4
 
+=item * Prior to perl 5.10, scalar slots are only considered to exist if they are defined
+
+This is due to a shortcoming within perl itself. See
+L<perlref/Making References> point 7 for more information.
+
 =item * GLOB and FORMAT variables are not (yet) accessible through this module.
 
 =item * Also, see the BUGS section for the specific backends (L<Package::Stash::XS> and L<Package::Stash::PP>)
diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm
index 76129ed..227970a 100644
--- a/lib/Package/Stash/PP.pm
+++ b/lib/Package/Stash/PP.pm
@@ -3,6 +3,7 @@ use strict;
 use warnings;
 # ABSTRACT: pure perl implementation of the Package::Stash API
 
+use B;
 use Carp qw(confess);
 use Scalar::Util qw(blessed reftype weaken);
 use Symbol;
@@ -12,6 +13,9 @@ use constant BROKEN_ISA_ASSIGNMENT => ($] < 5.012);
 # before 5.10, stashes don't ever seem to drop to a refcount of zero, so
 # weakening them isn't helpful
 use constant BROKEN_WEAK_STASH     => ($] < 5.010);
+# before 5.10, the scalar slot was always treated as existing if the
+# glob existed
+use constant BROKEN_SCALAR_INITIALIZATION => ($] < 5.010);
 
 =head1 SYNOPSIS
 
@@ -160,12 +164,13 @@ sub has_symbol {
 
     my $entry_ref = \$namespace->{$name};
     if (reftype($entry_ref) eq 'GLOB') {
-        # XXX: assigning to any typeglob slot also initializes the SCALAR slot,
-        # and saying that an undef scalar variable doesn't exist is probably
-        # vaguely less surprising than a scalar variable popping into existence
-        # without anyone defining it
         if ($type eq 'SCALAR') {
-            return defined ${ *{$entry_ref}{$type} };
+            if (BROKEN_SCALAR_INITIALIZATION) {
+                return defined ${ *{$entry_ref}{$type} };
+            }
+            else {
+                return B::svref_2object($entry_ref)->SV->isa('B::SV');
+            }
         }
         else {
             return defined *{$entry_ref}{$type};
@@ -269,25 +274,25 @@ sub remove_symbol {
         $io     = $self->get_symbol($io_desc)     if $self->has_symbol($io_desc);
     }
     elsif ($type eq 'ARRAY') {
-        $scalar = $self->get_symbol($scalar_desc);
+        $scalar = $self->get_symbol($scalar_desc) if $self->has_symbol($scalar_desc) || BROKEN_SCALAR_INITIALIZATION;
         $hash   = $self->get_symbol($hash_desc)   if $self->has_symbol($hash_desc);
         $code   = $self->get_symbol($code_desc)   if $self->has_symbol($code_desc);
         $io     = $self->get_symbol($io_desc)     if $self->has_symbol($io_desc);
     }
     elsif ($type eq 'HASH') {
-        $scalar = $self->get_symbol($scalar_desc);
+        $scalar = $self->get_symbol($scalar_desc) if $self->has_symbol($scalar_desc) || BROKEN_SCALAR_INITIALIZATION;
         $array  = $self->get_symbol($array_desc)  if $self->has_symbol($array_desc);
         $code   = $self->get_symbol($code_desc)   if $self->has_symbol($code_desc);
         $io     = $self->get_symbol($io_desc)     if $self->has_symbol($io_desc);
     }
     elsif ($type eq 'CODE') {
-        $scalar = $self->get_symbol($scalar_desc);
+        $scalar = $self->get_symbol($scalar_desc) if $self->has_symbol($scalar_desc) || BROKEN_SCALAR_INITIALIZATION;
         $array  = $self->get_symbol($array_desc)  if $self->has_symbol($array_desc);
         $hash   = $self->get_symbol($hash_desc)   if $self->has_symbol($hash_desc);
         $io     = $self->get_symbol($io_desc)     if $self->has_symbol($io_desc);
     }
     elsif ($type eq 'IO') {
-        $scalar = $self->get_symbol($scalar_desc);
+        $scalar = $self->get_symbol($scalar_desc) if $self->has_symbol($scalar_desc) || BROKEN_SCALAR_INITIALIZATION;
         $array  = $self->get_symbol($array_desc)  if $self->has_symbol($array_desc);
         $hash   = $self->get_symbol($hash_desc)   if $self->has_symbol($hash_desc);
         $code   = $self->get_symbol($code_desc)   if $self->has_symbol($code_desc);
@@ -298,7 +303,7 @@ sub remove_symbol {
 
     $self->remove_glob($name);
 
-    $self->add_symbol($scalar_desc => $scalar);
+    $self->add_symbol($scalar_desc => $scalar) if defined $scalar;
     $self->add_symbol($array_desc  => $array)  if defined $array;
     $self->add_symbol($hash_desc   => $hash)   if defined $hash;
     $self->add_symbol($code_desc   => $code)   if defined $code;
@@ -324,8 +329,14 @@ sub list_all_symbols {
     }
     elsif ($type_filter eq 'SCALAR') {
         return grep {
-            ref(\$namespace->{$_}) eq 'GLOB'
-                && defined(${*{$namespace->{$_}}{'SCALAR'}})
+            BROKEN_SCALAR_INITIALIZATION
+                ? (ref(\$namespace->{$_}) eq 'GLOB'
+                      && defined(${*{$namespace->{$_}}{'SCALAR'}}))
+                : (do {
+                      my $entry = \$namespace->{$_};
+                      ref($entry) eq 'GLOB'
+                          && B::svref_2object($entry)->SV->isa('B::SV')
+                  })
         } keys %{$namespace};
     }
     else {
@@ -352,11 +363,6 @@ sub get_all_symbols {
 
 =over 4
 
-=item * Scalar slots are only considered to exist if they are defined
-
-This is due to a shortcoming within perl itself. See
-L<perlref/Making References> point 7 for more information.
-
 =item * remove_symbol also replaces the associated typeglob
 
 This can cause unexpected behavior when doing manipulation at compile time -
diff --git a/t/basic.t b/t/basic.t
index 77c9c13..a106e9e 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -391,8 +391,8 @@ like(exception {
         [qw(BEGIN bar baz foo quuuux quuux quux)],
         "list_all_symbols",
     );
-    { local $TODO = ($] < 5.010 || $Package::Stash::IMPLEMENTATION eq 'PP')
-          ? "undef scalars aren't visible on 5.8, or from pure perl at all"
+    { local $TODO = $] < 5.010
+          ? "undef scalars aren't visible on 5.8"
           : undef;
     is_deeply(
         [sort $quuux->list_all_symbols('SCALAR')],
diff --git a/t/edge-cases.t b/t/edge-cases.t
index 7c82626..04e2164 100755
--- a/t/edge-cases.t
+++ b/t/edge-cases.t
@@ -26,8 +26,8 @@ use Package::Stash;
 }
 
 my $stash = Package::Stash->new('Foo');
-{ local $TODO = ($] < 5.010 || $Package::Stash::IMPLEMENTATION eq 'PP')
-      ? "undef scalars aren't visible on 5.8, or from pure perl at all"
+{ local $TODO = $] < 5.010
+      ? "undef scalars aren't visible on 5.8"
       : undef;
 ok($stash->has_symbol('$SCALAR'), '$SCALAR');
 }
diff --git a/t/impl-selection/basic-pp.t b/t/impl-selection/basic-pp.t
index 7388e80..398f383 100644
--- a/t/impl-selection/basic-pp.t
+++ b/t/impl-selection/basic-pp.t
@@ -395,8 +395,8 @@ like(exception {
         [qw(BEGIN bar baz foo quuuux quuux quux)],
         "list_all_symbols",
     );
-    { local $TODO = ($] < 5.010 || $Package::Stash::IMPLEMENTATION eq 'PP')
-          ? "undef scalars aren't visible on 5.8, or from pure perl at all"
+    { local $TODO = $] < 5.010
+          ? "undef scalars aren't visible on 5.8"
           : undef;
     is_deeply(
         [sort $quuux->list_all_symbols('SCALAR')],
diff --git a/t/impl-selection/basic-xs.t b/t/impl-selection/basic-xs.t
index bffd3b7..0fe2aa3 100644
--- a/t/impl-selection/basic-xs.t
+++ b/t/impl-selection/basic-xs.t
@@ -396,8 +396,8 @@ like(exception {
         [qw(BEGIN bar baz foo quuuux quuux quux)],
         "list_all_symbols",
     );
-    { local $TODO = ($] < 5.010 || $Package::Stash::IMPLEMENTATION eq 'PP')
-          ? "undef scalars aren't visible on 5.8, or from pure perl at all"
+    { local $TODO = $] < 5.010
+          ? "undef scalars aren't visible on 5.8"
           : undef;
     is_deeply(
         [sort $quuux->list_all_symbols('SCALAR')],