From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 8 Aug 2006 17:59:14 +0000 (+0000)
Subject: broken-tests
X-Git-Tag: 0_33~11^2~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c20522bd825495befde91f3201a71909d80dd31c;p=gitmo%2FClass-MOP.git

broken-tests
---

diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 184dd13..87b4216 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -6,6 +6,7 @@ use warnings;
 
 use Scalar::Util 'blessed';
 use Carp         'confess';
+use Symbol       'gensym';
 
 our $VERSION = '0.02';
 
@@ -74,8 +75,9 @@ sub add_package_symbol {
 
     my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
 
+
     no strict 'refs';
-    no warnings 'misc', 'redefine';
+    no warnings 'redefine', 'misc';
     *{$self->name . '::' . $name} = $initial_value;    
 }
 
@@ -84,7 +86,7 @@ sub has_package_symbol {
 
     my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
 
-    return 0 unless exists $self->namespace->{$name};    
+    return 0 unless exists $self->namespace->{$name};   
     defined *{$self->namespace->{$name}}{$type} ? 1 : 0;
 }
 
@@ -93,9 +95,9 @@ sub get_package_symbol {
 
     my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
 
-    return *{$self->namespace->{$name}}{$type}
-        if exists $self->namespace->{$name};
-    $self->add_package_symbol($variable);
+    $self->add_package_symbol($variable)
+        unless exists $self->namespace->{$name};
+    return *{$self->namespace->{$name}}{$type};
 }
 
 sub remove_package_symbol {
@@ -103,30 +105,30 @@ sub remove_package_symbol {
 
     my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); 
 
+    no strict 'refs';
     if ($type eq 'SCALAR') {
-        undef ${$self->namespace->{$name}};    
+        undef ${$self->name . '::' . $name};    
     }
     elsif ($type eq 'ARRAY') {
-        undef @{$self->namespace->{$name}};    
+        undef @{$self->name . '::' . $name};    
     }
     elsif ($type eq 'HASH') {
-        undef %{$self->namespace->{$name}};    
+        undef %{$self->name . '::' . $name};    
     }
     elsif ($type eq 'CODE') {
         # FIXME:
         # this is crap, it is probably much 
         # easier to write this in XS.
         my ($scalar, @array, %hash);
-        $scalar = ${$self->namespace->{$name}} if defined *{$self->namespace->{$name}}{SCALAR};
-        @array  = @{$self->namespace->{$name}} if defined *{$self->namespace->{$name}}{ARRAY};
-        %hash   = %{$self->namespace->{$name}} if defined *{$self->namespace->{$name}}{HASH};
-        {
-            no strict 'refs';
-            delete ${$self->name . '::'}{$name};
-        }
-        ${$self->namespace->{$name}} = $scalar if defined $scalar;
-        @{$self->namespace->{$name}} = @array  if scalar  @array;
-        %{$self->namespace->{$name}} = %hash   if keys    %hash;            
+        $scalar = ${$self->name . '::' . $name} if defined *{$self->namespace->{$name}}{SCALAR};
+        @array  = @{$self->name . '::' . $name} if defined *{$self->namespace->{$name}}{ARRAY};
+        %hash   = %{$self->name . '::' . $name} if defined *{$self->namespace->{$name}}{HASH};
+        
+        delete ${$self->name . '::'}{$name};
+        
+        ${$self->name . '::' . $name} = $scalar if defined $scalar;
+        @{$self->name . '::' . $name} = @array  if scalar  @array;
+        %{$self->name . '::' . $name} = %hash   if keys    %hash;            
     }    
     else {
         confess "This should never ever ever happen";
diff --git a/t/080_meta_package.t b/t/080_meta_package.t
index 3a0efbd..e398741 100644
--- a/t/080_meta_package.t
+++ b/t/080_meta_package.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 34;
+use Test::More tests => 43;
 use Test::Exception;
 
 BEGIN {
@@ -24,11 +24,27 @@ lives_ok {
     Foo->meta->add_package_symbol('%foo' => { one => 1 });
 } '... created %Foo::foo successfully';
 
+ok(!Foo->meta->has_package_symbol('$foo'), '... SCALAR shouldnt have been created too');
+
 ok(defined($Foo::{foo}), '... the %foo slot was created successfully');
 ok(Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
 
 {
     no strict 'refs';
+    ok(defined(*{"Foo::foo"}{HASH}), '... the %foo (HASH) slot was created successfully');
+
+    ok(!defined(*{"Foo::foo"}{SCALAR}), '... but the $foo slot was not created');
+    ok(!Foo->meta->has_package_symbol('$foo'), '... and the meta agrees');    
+
+    ok(!defined(*{"Foo::foo"}{ARRAY}),  '... but the @foo slot was not created');
+    ok(!Foo->meta->has_package_symbol('@foo'), '... and the meta agrees');    
+
+    ok(!defined(*{"Foo::foo"}{CODE}),   '... but the &foo slot was not created');
+    ok(!Foo->meta->has_package_symbol('&foo'), '... and the meta agrees');    
+}
+
+{
+    no strict 'refs';
     ok(exists ${'Foo::foo'}{one}, '... our %foo was initialized correctly');
     is(${'Foo::foo'}{one}, 1, '... our %foo was initialized correctly');
 }
@@ -99,6 +115,11 @@ lives_ok {
 
 ok(Foo->meta->has_package_symbol('%foo'), '... the %foo slot was removed successfully');
 
+{
+    no strict 'refs';
+    ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
+}
+
 # check some errors
 
 dies_ok {
@@ -116,8 +137,3 @@ dies_ok {
 dies_ok {
     Foo->meta->has_package_symbol('bar');
 } '... no sigil for bar';
-
-
-#dies_ok {
-#    Foo->meta->get_package_symbol('@.....bar');
-#} '... could not fetch variable';