From: Shawn M Moore <sartak@gmail.com>
Date: Sun, 18 May 2008 15:01:44 +0000 (+0000)
Subject: Make t/003_methods.t not dependent on Sub::Name (but still do its tests if it's avail... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c6ab8faae7b2aa63b8a009473ea984f8fb30a217;p=gitmo%2FClass-MOP.git

Make t/003_methods.t not dependent on Sub::Name (but still do its tests if it's available). It might be better to break Sub::Name tests out into a separate test script
---

diff --git a/t/003_methods.t b/t/003_methods.t
index b836875..b0b19e4 100644
--- a/t/003_methods.t
+++ b/t/003_methods.t
@@ -8,7 +8,7 @@ use Test::Exception;
 
 use Scalar::Util qw/reftype/;
 
-use Sub::Name ();
+my $has_subname = eval "require Sub::Name; 1";
 
 BEGIN {
     use_ok('Class::MOP');   
@@ -32,9 +32,10 @@ BEGIN {
     sub bar { 'Foo::bar' } 
     *baz = \&bar;
 
-    { # method named with Sub::Name inside the package scope
+    if ($has_subname) {
+        # method named with Sub::Name inside the package scope
         no strict 'refs';
-        *{'Foo::floob'} = Sub::Name::subname 'floob' => sub { '!floob!' }; 
+        *{'Foo::floob'} = Sub::Name::subname('floob' => sub { '!floob!' }); 
     }
 
     # We hateses the "used only once" warnings
@@ -52,9 +53,12 @@ BEGIN {
     {
         no strict 'refs';
         *{'Foo::bling'} = sub { '$$Bling$$' };
-        *{'Foo::bang'} = Sub::Name::subname('Foo::bang' => sub { '!BANG!' });
-        *{'Foo::boom'} = Sub::Name::subname('boom' => sub { '!BOOM!' });
-        
+
+        if ($has_subname) {
+            *{'Foo::bang'} = Sub::Name::subname('Foo::bang' => sub { '!BANG!' });
+            *{'Foo::boom'} = Sub::Name::subname('boom' => sub { '!BOOM!' });
+        }
+
         eval "package Foo; sub evaled_foo { 'Foo::evaled_foo' }";           
     }
 }
@@ -89,10 +93,15 @@ is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"');
 ok($Foo->has_method('FOO_CONSTANT'), '... Foo->has_method(FOO_CONSTANT) (defined w/ use constant)');
 ok($Foo->has_method('bar'), '... Foo->has_method(bar) (defined in Foo)');
 ok($Foo->has_method('baz'), '... Foo->has_method(baz) (typeglob aliased within Foo)');
-ok($Foo->has_method('floob'), '... Foo->has_method(floob) (defined in Foo:: using symbol tables and Sub::Name w/out package name)');
+
+SKIP: {
+    skip "Tests require Sub::Name", 2 unless $has_subname;
+    ok($Foo->has_method('floob'), '... Foo->has_method(floob) (defined in Foo:: using symbol tables and Sub::Name w/out package name)');
+    ok($Foo->has_method('bang'), '... Foo->has_method(bang) (defined in main:: using symbol tables and Sub::Name)');
+};
+
 ok($Foo->has_method('blah'), '... Foo->has_method(blah) (defined in main:: using fully qualified package name)');
 ok($Foo->has_method('bling'), '... Foo->has_method(bling) (defined in main:: using symbol tables (no Sub::Name))');
-ok($Foo->has_method('bang'), '... Foo->has_method(bang) (defined in main:: using symbol tables and Sub::Name)');
 ok($Foo->has_method('evaled_foo'), '... Foo->has_method(evaled_foo) (evaled in main::)');
 
 my $OinkyBoinky = Class::MOP::Class->initialize('OinkyBoinky');
@@ -115,11 +124,16 @@ for my $method_name (qw/FOO_CONSTANT
                     	bling
                     	bang	
                     	evaled_foo/) {
-    isa_ok($Foo->get_method($method_name), 'Class::MOP::Method');
-    {
-        no strict 'refs';
-        is($Foo->get_method($method_name)->body, \&{'Foo::' . $method_name}, '... body matches CODE ref in package for ' . $method_name);
-    }
+    my $requires_subname = $method_name eq 'floob' || $method_name eq 'bang';
+    SKIP: {
+        skip "Tests require Sub::Name", 2 if $requires_subname && !$has_subname;
+
+        isa_ok($Foo->get_method($method_name), 'Class::MOP::Method');
+        {
+            no strict 'refs';
+            is($Foo->get_method($method_name)->body, \&{'Foo::' . $method_name}, '... body matches CODE ref in package for ' . $method_name);
+        }
+    };
 }
 
 {
@@ -139,9 +153,13 @@ ok(!$Foo->has_method('boom'), '... !Foo->has_method(boom) (defined in main:: usi
 ok(!$Foo->has_method('not_a_real_method'), '... !Foo->has_method(not_a_real_method) (does not exist)');
 is($Foo->get_method('not_a_real_method'), undef, '... Foo->get_method(not_a_real_method) == undef');
 
+my @expected_methods = $has_subname
+                     ? qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob foo)
+                     : qw(FOO_CONSTANT bar baz blah bling evaled_foo foo);
+
 is_deeply(
     [ sort $Foo->get_method_list ],
-    [ qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob foo) ],
+    \@expected_methods,
     '... got the right method list for Foo');
 
 is_deeply(
@@ -153,36 +171,28 @@ is_deeply(
             class => 'Foo',
             code  => $Foo->get_method($_)
             }
-        } qw(
-            FOO_CONSTANT
-            bang 
-            bar 
-            baz 
-            blah 
-            bling 
-            evaled_foo 
-            floob 
-            foo
-        )
+        } @expected_methods
     ],
     '... got the right list of applicable methods for Foo');
 
 is($Foo->remove_method('foo')->body, $foo, '... removed the foo method');
 ok(!$Foo->has_method('foo'), '... !Foo->has_method(foo) we just removed it');
 dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there';
+@expected_methods = grep { $_ ne 'foo' } @expected_methods;
 
 is_deeply(
     [ sort $Foo->get_method_list ],
-    [ qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob) ],
+    \@expected_methods,
     '... got the right method list for Foo');
 
 ok($Foo->remove_method('FOO_CONSTANT'), '... removed the FOO_CONSTANT method');
 ok(!$Foo->has_method('FOO_CONSTANT'), '... !Foo->has_method(FOO_CONSTANT) we just removed it');
 dies_ok { Foo->FOO_CONSTANT } '... cannot call Foo->FOO_CONSTANT because it is not there';
+@expected_methods = grep { $_ ne 'FOO_CONSTANT' } @expected_methods;
 
 is_deeply(
     [ sort $Foo->get_method_list ],
-    [ qw(bang bar baz blah bling evaled_foo floob) ],
+    \@expected_methods,
     '... got the right method list for Foo');
 
 # ... test our class creator 
@@ -214,44 +224,51 @@ is_deeply(
     [ sort $Bar->get_method_list ],
     [ qw(bar foo meta) ],
     '... got the right method list for Bar');  
-    
-is_deeply(
-    [ sort { $a->{name} cmp $b->{name} } $Bar->compute_all_applicable_methods() ],
-    [
+
+my @expected_bar_methods;
+push @expected_bar_methods, {
+    name  => 'bang',
+    class => 'Foo',
+    code  => $Foo->get_method('bang')
+} if $has_subname;
+
+push @expected_bar_methods, (
+    {
+        name  => 'bar',
+        class => 'Bar',
+        code  => $Bar->get_method('bar')
+    },
+    (map {
         {
-            name  => 'bang',
+            name  => $_,
             class => 'Foo',
-            code  => $Foo->get_method('bang')
-        },
-        {
-            name  => 'bar',
-            class => 'Bar',
-            code  => $Bar->get_method('bar') 
-        },
-        (map {
-            {
-                name  => $_,
-                class => 'Foo',
-                code  => $Foo->get_method($_)
-            }
-        } qw(        
-            baz 
-            blah 
-            bling 
-            evaled_foo 
-            floob 
-        )),
-        {
-            name  => 'foo',
-            class => 'Bar',
-            code  => $Bar->get_method('foo')
-        },        
-        {
-            name  => 'meta',
-            class => 'Bar',
-            code  => $Bar->get_method('meta')
-        }        
-    ],
+            code  => $Foo->get_method($_)
+        }
+    } qw(baz blah bling evaled_foo)),
+);
+
+push @expected_bar_methods, {
+    name  => 'floob',
+    class => 'Foo',
+    code  => $Foo->get_method('floob')
+} if $has_subname;
+
+push @expected_bar_methods, (
+    {
+        name  => 'foo',
+        class => 'Bar',
+        code  => $Bar->get_method('foo')
+    },
+    {
+        name  => 'meta',
+        class => 'Bar',
+        code  => $Bar->get_method('meta')
+    }
+);
+
+is_deeply(
+    [ sort { $a->{name} cmp $b->{name} } $Bar->compute_all_applicable_methods() ],
+    \@expected_bar_methods,
     '... got the right list of applicable methods for Bar');