Allow metaclasses to be reinitialized from an existing metaclass, instead of only...
Florian Ragwitz [Thu, 30 Jul 2009 12:16:46 +0000 (14:16 +0200)]
Makefile.PL
lib/Class/MOP/Package.pm
t/049_metaclass_reinitialize.t [new file with mode: 0644]

index 8610c40..a872582 100644 (file)
@@ -22,7 +22,7 @@ requires 'Sub::Name'    => '0.04';
 requires 'Task::Weaken';
 
 test_requires 'File::Spec';
-test_requires 'Test::More'      => '0.77';
+test_requires 'Test::More'      => '0.88';
 test_requires 'Test::Exception' => '0.27';
 
 extra_tests();
index 30e8dfb..92463aa 100644 (file)
@@ -49,8 +49,12 @@ sub reinitialize {
     my %options = @args;
     my $package_name = delete $options{package};
 
-    (defined $package_name && $package_name && !blessed($package_name))
-        || confess "You must pass a package name and it cannot be blessed";
+    (defined $package_name && $package_name
+      && (!blessed $package_name || $package_name->isa('Class::MOP::Package')))
+        || confess "You must pass a package name or an existing Class::MOP::Package instance";
+
+    $package_name = $package_name->name
+        if blessed $package_name;
 
     Class::MOP::remove_metaclass_by_name($package_name);
 
@@ -437,10 +441,12 @@ This method creates a new C<Class::MOP::Package> instance which
 represents specified package. If an existing metaclass object exists
 for the package, that will be returned instead.
 
-=item B<< Class::MOP::Package->reinitialize($package_name) >>
+=item B<< Class::MOP::Package->reinitialize($package) >>
 
 This method forcibly removes any existing metaclass for the package
-before calling C<initialize>
+before calling C<initialize>. In contrast to C<initialize>, you may
+also pass an existing C<Class::MOP::Package> instance instead of just
+a package name as C<$package>.
 
 Do not call this unless you know what you are doing.
 
diff --git a/t/049_metaclass_reinitialize.t b/t/049_metaclass_reinitialize.t
new file mode 100644 (file)
index 0000000..a9c0e26
--- /dev/null
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+{
+    package Foo;
+    use metaclass;
+    sub foo {}
+}
+
+sub check_meta_sanity {
+    my ($meta) = @_;
+    isa_ok($meta, 'Class::MOP::Class');
+    is($meta->name, 'Foo');
+    ok($meta->has_method('foo'));
+}
+
+can_ok('Foo', 'meta');
+
+my $meta = Foo->meta;
+check_meta_sanity($meta);
+
+lives_ok {
+    $meta = $meta->reinitialize($meta->name);
+};
+check_meta_sanity($meta);
+
+lives_ok {
+    $meta = $meta->reinitialize($meta);
+};
+check_meta_sanity($meta);
+
+throws_ok {
+    $meta->reinitialize('');
+} qr/You must pass a package name or an existing Class::MOP::Package instance/;
+
+throws_ok {
+    $meta->reinitialize($meta->new_object);
+} qr/You must pass a package name or an existing Class::MOP::Package instance/;
+
+done_testing;