fix load_first_existing_class to die on an existing class that fails to compile

diff --git a/Changes b/Changes
index 4ef852d..a251ac7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -11,6 +11,12 @@ Revision history for Perl extension Class-MOP.
         metaclass. This is unlike get_metaclass_by_name in that
         it accepts instances, not just class names. (Sartak)
 
+    * Class::MOP
+      - load_first_existing_class didn't actually load the first existing
+        class; instead, it loaded the first existing and compiling class.  It
+        now throws an error if a class exists (in @INC) but fails to compile.
+        (hdp)
+
 0.79 Fri, March 29, 2009
     * No changes from 0.78_02.
 

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index e4962e9..b536dbc 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -72,6 +72,15 @@ XSLoader::load( __PACKAGE__, $XS_VERSION );
     # because I don't yet see a good reason to do so.
 }
 
+sub _class_to_pmfile {
+    my $class = shift;
+
+    my $file = $class . '.pm';
+    $file =~ s{::}{/}g;
+
+    return $file;
+}
+
 sub load_first_existing_class {
     my @classes = @_
         or return;
@@ -86,10 +95,12 @@ sub load_first_existing_class {
     my $found;
     my %exceptions;
     for my $class (@classes) {
+        my $pmfile = _class_to_pmfile($class);
         my $e = _try_load_one_class($class);
 
         if ($e) {
             $exceptions{$class} = $e;
+            last if $e !~ /^Can't locate \Q$pmfile\E in \@INC/;
         }
         else {
             $found = $class;
@@ -106,6 +117,9 @@ sub load_first_existing_class {
                 "Could not load class (%s) because : %s", $_,
                 $exceptions{$_}
                 )
+            }
+        grep {
+            exists $exceptions{$_}
             } @classes
     );
 }
@@ -114,9 +128,8 @@ sub _try_load_one_class {
     my $class = shift;
 
     return if is_class_loaded($class);
-
-    my $file = $class . '.pm';
-    $file =~ s{::}{/}g;
+    
+    my $file = _class_to_pmfile($class);
 
     return do {
         local $@;

diff --git a/t/083_load_class.t b/t/083_load_class.t
index e93c427..7d9437b 100644 (file)
--- a/t/083_load_class.t
+++ b/t/083_load_class.t
@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More tests => 33;
+use Test::More tests => 34;
 use Test::Exception;
 
 require Class::MOP;
@@ -51,6 +51,15 @@ throws_ok {
 qr/Missing right curly/;
 
 throws_ok {
+    delete $INC{'SyntaxError.pm'};
+    Class::MOP::load_first_existing_class(
+        'FakeClassOhNo', 'SyntaxError', 'Class'
+    );
+}
+qr/Missing right curly/, 
+    'load_first_existing_class does not pass over an existing (bad) module';
+
+throws_ok {
     Class::MOP::load_class('This::Does::Not::Exist');
 }
 qr/Could not load class \(This::Does::Not::Exist\) because :/,