From: Shawn M Moore <sartak@gmail.com>
Date: Tue, 31 Mar 2009 03:31:33 +0000 (-0400)
Subject: Remove the pure-perl fallback of CMOP::Class->subclasses
X-Git-Tag: 0.80~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ffd0984599ac2aae5fabb0759c313b85f7455003;p=gitmo%2FClass-MOP.git

Remove the pure-perl fallback of CMOP::Class->subclasses

    MRO::Compat and mro have always had get_isarev, and HAS_ISAREV was
    always true anyway. That pure-perl fallback has literally never been
    run since August.
---

diff --git a/Changes b/Changes
index c1c46cc..44e5129 100644
--- a/Changes
+++ b/Changes
@@ -21,6 +21,15 @@ Revision history for Perl extension Class-MOP.
         now throws an error if a class exists (in @INC) but fails to compile.
         (hdp)
 
+    * Class::MOP::Class
+    * Class::MOP
+      - we had some semi-buggy code that purported to provide a
+        HAS_ISAREV based on whether mro had get_isarev (due
+        to an oversight, it always returned 1). Since mro and
+        MRO::Compat have always had get_isarev, HAS_ISAREV was
+        pointless. This insight simplified the subclasses method
+        by deleting the pure-perl fallback. (Sartak)
+
 0.79 Fri, March 29, 2009
     * No changes from 0.78_02.
 
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 482797e..275b9ac 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -474,51 +474,9 @@ sub superclasses {
 
 sub subclasses {
     my $self = shift;
-
     my $super_class = $self->name;
 
-    if ( Class::MOP::HAVE_ISAREV() ) {
-        return @{ $super_class->mro::get_isarev() };
-    } else {
-        my @derived_classes;
-
-        my $find_derived_classes;
-        $find_derived_classes = sub {
-            my ($outer_class) = @_;
-
-            my $symbol_table_hashref = do { no strict 'refs'; \%{"${outer_class}::"} };
-
-            SYMBOL:
-            for my $symbol ( keys %$symbol_table_hashref ) {
-                next SYMBOL if $symbol !~ /\A (\w+):: \z/x;
-                my $inner_class = $1;
-
-                next SYMBOL if $inner_class eq 'SUPER';    # skip '*::SUPER'
-
-                my $class =
-                $outer_class
-                ? "${outer_class}::$inner_class"
-                : $inner_class;
-
-                if ( $class->isa($super_class) and $class ne $super_class ) {
-                    push @derived_classes, $class;
-                }
-
-                next SYMBOL if $class eq 'main';           # skip 'main::*'
-
-                $find_derived_classes->($class);
-            }
-        };
-
-        my $root_class = q{};
-        $find_derived_classes->($root_class);
-
-        undef $find_derived_classes;
-
-        @derived_classes = sort { $a->isa($b) ? 1 : $b->isa($a) ? -1 : 0 } @derived_classes;
-
-        return @derived_classes;
-    }
+    return @{ $super_class->mro::get_isarev() };
 }