From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 14 Jun 2016 08:35:50 +0000 (+0200)
Subject: Allow alternative mro-type specification on method listing
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1cf2ad8b03a2b1ad34183905475d1d9afd614aba;p=dbsrgits%2FDBIx-Class-Historic.git

Allow alternative mro-type specification on method listing

This is needed for the mro sanity check further up
---

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index f1a3619..f4bda73 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -653,11 +653,22 @@ sub modver_gt_or_eq_and_lt ($$$) {
   our $describe_class_query_cache;
 
   sub describe_class_methods {
-    my ($class) = @_;
+    my ($class, $requested_mro) = @_;
 
     croak "Expecting a class name"
       if not defined $class or $class !~ $module_name_rx;
 
+    $requested_mro ||= mro::get_mro($class);
+
+    # mro::set_mro() does not bump pkg_gen - WHAT THE FUCK?!
+    my $query_cache_key = "$class|$requested_mro";
+
+    my $stack_cache_key =
+      ( mro::get_mro($class) eq $requested_mro )
+        ? $class
+        : $query_cache_key
+    ;
+
     # use a cache on old MRO, since while we are recursing in this function
     # nothing can possibly change (the speedup is immense)
     # (yes, people could be tie()ing the stash and adding methods on access
@@ -674,9 +685,9 @@ sub modver_gt_or_eq_and_lt ($$$) {
     $my_gen += get_real_pkg_gen($_) for ( my @full_ISA = (
 
       @{
-        $mro_recursor_stack->{cache}{$class}{linear_isa}
+        $mro_recursor_stack->{cache}{$stack_cache_key}{linear_isa}
           ||=
-        mro::get_linear_isa($class)
+        mro::get_linear_isa($class, $requested_mro)
       },
 
       ((
@@ -691,7 +702,7 @@ sub modver_gt_or_eq_and_lt ($$$) {
 
     ));
 
-    my $slot = $describe_class_query_cache->{$class} ||= {};
+    my $slot = $describe_class_query_cache->{$query_cache_key} ||= {};
 
     unless ( ($slot->{cumulative_gen}||0) == $my_gen ) {
 
@@ -702,15 +713,15 @@ sub modver_gt_or_eq_and_lt ($$$) {
       %$slot = (
         class => $class,
         isa => [
-          @{ $mro_recursor_stack->{cache}{$class}{linear_isa} }
-            [ 1 .. $#{$mro_recursor_stack->{cache}{$class}{linear_isa}} ]
+          @{ $mro_recursor_stack->{cache}{$stack_cache_key}{linear_isa} }
+            [ 1 .. $#{$mro_recursor_stack->{cache}{$stack_cache_key}{linear_isa}} ]
         ],
         mro => {
-          type => mro::get_mro($class),
+          type => $requested_mro,
+          is_c3 => ( ($requested_mro eq 'c3') ? 1 : 0 ),
         },
         cumulative_gen => $my_gen,
       );
-      $slot->{mro}{is_c3} = ($slot->{mro}{type} eq 'c3') ? 1 : 0;
 
       # ensure the cache is populated for the parents, code below can then
       # efficiently operate over the query_cache directly
@@ -750,7 +761,7 @@ sub modver_gt_or_eq_and_lt ($$$) {
         # what describe_class_methods for @full_ISA produced above
         ( map { values %{
           $describe_class_query_cache->{$_}{methods_defined_in_class} || {}
-        } } reverse @full_ISA ),
+        } } map { "$_|" . mro::get_mro($_) } reverse @full_ISA ),
 
         # our own non-cleaned subs + their attributes
         ( map {
diff --git a/xt/extra/internals/attributes.t b/xt/extra/internals/attributes.t
index 4e36e72..1f9d7b5 100644
--- a/xt/extra/internals/attributes.t
+++ b/xt/extra/internals/attributes.t
@@ -424,6 +424,61 @@ sub add_more_attrs {
     $expected_desc,
     'describe_class_methods returns correct data',
   );
+
+  # ensure that asking with a different MRO will not perturb the cache
+  my $cached_desc = serialize(
+    $DBIx::Class::_Util::describe_class_query_cache->{"DBICTest::AttrTest|c3"}
+  );
+
+  # now try to ask for DFS explicitly, adjust our expectations
+  $expected_desc->{mro} = { type => 'dfs', is_c3 => 0 };
+
+  # due to DFS the last 2 entries of ISA and the VALID_DBIC_CODE_ATTRIBUTE
+  # sourcing-list will change places
+  splice @$_, -2, 2, @{$_}[-1, -2]
+    for $V_D_C_A_stack, $expected_AttrTest_ISA;
+
+  is_deeply (
+    # work around taint, see TODO below
+    {
+      %{describe_class_methods("DBICTest::AttrTest", "dfs")},
+      cumulative_gen => $expected_desc->{cumulative_gen},
+    },
+    $expected_desc,
+    'describing with explicit mro returns correct data'
+  );
+
+  # FIXME: TODO does not work on new T::B under threads sigh
+  # https://github.com/Test-More/test-more/issues/683
+  unless(
+    ! DBIx::Class::_ENV_::OLD_MRO
+      and
+    ${^TAINT}
+  ) {
+    #local $TODO = "On 5.10+ -T combined with stash peeking invalidates the pkg_gen (wtf)" if ...
+
+    ok(
+      (
+        serialize( describe_class_methods("DBICTest::AttrTest") )
+          eq
+        $cached_desc
+      ),
+      "Asking for alternative mro type did not invalidate cache"
+    );
+  }
+
+  # setting mro explicitly still matches what we expect
+  mro::set_mro("DBICTest::AttrTest", "dfs");
+
+  is_deeply (
+    # in case set_mro starts increasing pkg_gen...
+    {
+      %{describe_class_methods("DBICTest::AttrTest")},
+      cumulative_gen => $expected_desc->{cumulative_gen},
+    },
+    $expected_desc,
+    'describing with implicit mro returns correct data'
+  );
 }
 
 if ($skip_threads) {