rt63818 bugfix for false 'also' circular ref error

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index fc3a495..da46de8 100644 (file)
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -133,44 +133,71 @@ sub _make_exporter {
     );
 }
 
-{
-    my $seen = {};
+sub _follow_also {
+    my $class             = shift;
+    my $exporting_package = shift;
+
+    _die_if_cycle_found_in_also_list_for_package($exporting_package);
 
-    sub _follow_also {
-        my $class             = shift;
-        my $exporting_package = shift;
+    return uniq( _follow_also_real($exporting_package) );
+}
+
+sub _follow_also_real {
+    my $exporting_package = shift;
+    my @also              = _also_list_for_package($exporting_package);
+
+    return map { $_, _follow_also_real($_) } @also;
+}
+
+sub _also_list_for_package {
+    my $package = shift;
 
-        local %$seen = ( $exporting_package => 1 );
+    if ( !exists $EXPORT_SPEC{$package} ) {
+        my $loaded = is_class_loaded($package);
 
-        return uniq( _follow_also_real($exporting_package) );
+        die "Package in also ($package) does not seem to "
+            . "use Moose::Exporter"
+            . ( $loaded ? "" : " (is it loaded?)" );
     }
 
-    sub _follow_also_real {
-        my $exporting_package = shift;
+    my $also = $EXPORT_SPEC{$package}{also};
 
-        if ( !exists $EXPORT_SPEC{$exporting_package} ) {
-            my $loaded = is_class_loaded($exporting_package);
+    return unless defined $also;
 
-            die "Package in also ($exporting_package) does not seem to "
-                . "use Moose::Exporter"
-                . ( $loaded ? "" : " (is it loaded?)" );
-        }
+    return ref $also ? @$also : $also;
+}
+
+# this is no Tarjan algorithm, but for the list sizes expected,
+# brute force will probably be fine (and more maintainable)
+sub _die_if_cycle_found_in_also_list_for_package {
+    my $package = shift;
+    _die_if_also_list_cycles_back_to_existing_stack(
+        [ _also_list_for_package($package) ],
+        [$package],
+    );
+}
 
-        my $also = $EXPORT_SPEC{$exporting_package}{also};
+sub _die_if_also_list_cycles_back_to_existing_stack {
+    my ( $also_list, $existing_stack ) = @_;
 
-        return unless defined $also;
+    return unless @$also_list && @$existing_stack;
 
-        my @also = ref $also ? @{$also} : $also;
+    for my $also_member (@$also_list) {
+        for my $stack_member (@$existing_stack) {
+            next unless $also_member eq $stack_member;
 
-        for my $package (@also) {
             die
-                "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package"
-                if $seen->{$package};
-
-            $seen->{$package} = 1;
+                "Circular reference in 'also' parameter to Moose::Exporter between "
+                . join(
+                ', ',
+                @$existing_stack
+                ) . " and $also_member";
         }
 
-        return map { $_, _follow_also_real($_) } @also;
+        _die_if_also_list_cycles_back_to_existing_stack(
+            [ _also_list_for_package($also_member) ],
+            [ $also_member, @$existing_stack ],
+        );
     }
 }
 

diff --git a/t/bugs/moose_exporter_false_circular_reference_rt_63818.t b/t/bugs/moose_exporter_false_circular_reference_rt_63818.t
new file mode 100644 (file)
index 0000000..95aab9e
--- /dev/null
+++ b/t/bugs/moose_exporter_false_circular_reference_rt_63818.t
@@ -0,0 +1,156 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+# OKSet1
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet1::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+}
+
+# OKSet2
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet2::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet2::ModuleB;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+}
+
+# OKSet3
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet3::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet3::ModuleB;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet3::ModuleA',
+        ]
+    );
+}
+
+# OKSet4
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet4::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet4::ModuleB;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet4::ModuleA',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet4::ModuleC;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet4::ModuleA',
+            'TESTING::MooseExporter::Rt63818::OKSet4::ModuleB',
+        ]
+    );
+}
+
+# OKSet5
+{
+
+    package TESTING::MooseExporter::Rt63818::OKSet5::ModuleA;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet5::ModuleB;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleA',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet5::ModuleC;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleA',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleB',
+        ]
+    );
+
+    package TESTING::MooseExporter::Rt63818::OKSet5::ModuleD;
+    use Moose ();
+    Moose::Exporter->setup_import_methods(
+        also => [
+            'Moose',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleA',
+            'TESTING::MooseExporter::Rt63818::OKSet5::ModuleC',
+        ]
+    );
+}
+
+# NotOKSet1
+{
+
+    package TESTING::MooseExporter::Rt63818::NotOKSet1::ModuleA;
+    use Moose ();
+    ::like(
+        ::exception { Moose::Exporter->setup_import_methods(
+                also => [
+                    'Moose',
+                    'TESTING::MooseExporter::Rt63818::NotOKSet1::ModuleA',
+                ]
+            )
+            },
+        qr/\QCircular reference in 'also' parameter to Moose::Exporter between TESTING::MooseExporter::Rt63818::NotOKSet1::ModuleA and TESTING::MooseExporter::Rt63818::NotOKSet1::ModuleA/,
+        'a single-hop circular reference in also dies with an error'
+    );
+}
+
+# Alas, I've not figured out how to craft a test which shows that we get the
+# same error for multi-hop circularity... instead I get tests that die because
+# one of the circularly-referenced things was not loaded.
+
+done_testing;