Merge pull request #2749 from vrurg/issue_2178

Fix for #2178: .wrap breaks method dispatching for inheriting classes.

src/Perl6/Metamodel/Dispatchers.nqp

@@ -1,32 +1,64 @@
 class Perl6::Metamodel::BaseDispatcher {
     has @!candidates;
     has $!idx;
+    has $!next_dispatcher; # The dispatcher we must pass control to when own queue exhausts
 
     method candidates() { @!candidates }
 
-    method exhausted() { $!idx >= +@!candidates }
+    method exhausted() { $!idx >= +@!candidates && (!nqp::isconcrete($!next_dispatcher) || $!next_dispatcher.exhausted()) }
 
     method last()      { @!candidates := [] }
 
+    method set_next_dispatcher($next_dispatcher) { $!next_dispatcher := $next_dispatcher }
+
+    # Wrapper-like dispatchers don't set dispatcher for the last candidate.
+    method is_wrapper_like() { 0 }
+
+    method get_call() { # Returns [$call, $is_dispatcher]
+        my $call := @!candidates[$!idx++];
+
+        my $disp;
+        try {
+            # XXX Are there any better way to determine a invocation handler with own dispatcher in $!dispatcher?
+            $disp := nqp::getattr($call, nqp::what($call), '$!dispatcher'); # If $call is a handler. But there must be better way to deal with this.
+            $disp := nqp::null() unless nqp::istype($disp, Perl6::Metamodel::BaseDispatcher); # Protect from multi-Routine dispatcher attribute
+        }
+        if nqp::isconcrete($disp) {
+            return [$disp, 1];
+        }
+        else {
+            my $last_candidate := $!idx >= +@!candidates;
+            if  $last_candidate && nqp::isconcrete($!next_dispatcher) {
+                nqp::setdispatcherfor($!next_dispatcher, $call);
+                $!next_dispatcher := nqp::null();
+            }
+            else {
+                nqp::setdispatcherfor(self, $call) unless $last_candidate && self.is_wrapper_like;
+            }
+        }
+        [$call, 0]
+    }
+
     method call_with_args(*@pos, *%named) {
-        my $call := @!candidates[$!idx];
-        $!idx := $!idx + 1;
+        my @call := self.get_call;
+        if @call[1] {
+            return @call[0].enter_with_args(@pos, %named, :next_dispatcher(self));
+        }
         if self.has_invocant {
             my $inv := self.invocant;
-            nqp::setdispatcherfor(self, $call);
-            $call($inv, |@pos, |%named);
+            @call[0]($inv, |@pos, |%named);
         }
         else {
-            nqp::setdispatcherfor(self, $call);
-            $call(|@pos, |%named);
+            @call[0](|@pos, |%named);
         }
     }
 
     method call_with_capture($capture) {
-        my $call := @!candidates[$!idx];
-        $!idx := $!idx + 1;
-        nqp::setdispatcherfor(self, $call);
-        nqp::invokewithcapture(nqp::decont($call), $capture)
+        my @call := self.get_call;
+        if @call[1] { # Got a dispatcher
+            return @call[0].enter_with_capture($capture, :next_dispatcher(self));
+        }
+        nqp::invokewithcapture(@call[0], $capture);
     }
 
     method shift_callee() {
@@ -103,6 +135,8 @@ class Perl6::Metamodel::WrapDispatcher is Perl6::Metamodel::BaseDispatcher {
 
     method has_invocant() { 0 }
 
+    method is_wrapper_like() { 1 }
+
     method add($wrapper) {
         self.candidates.unshift($wrapper)
     }
@@ -120,10 +154,25 @@ class Perl6::Metamodel::WrapDispatcher is Perl6::Metamodel::BaseDispatcher {
         return 0;
     }
 
-    method enter(*@pos, *%named) {
+    method get_first($next_dispatcher) {
         my $fresh := nqp::clone(self);
+        $fresh.set_next_dispatcher($next_dispatcher) if $next_dispatcher;
         my $first := self.candidates[0];
         nqp::setdispatcherfor($fresh, $first);
-        $first(|@pos, |%named)
+        $first
+    }
+
+    # This method is a bridge between Perl6 and NQP.
+    method enter(*@pos, *%named) {
+        self.enter_with_args(@pos, %named);
+    }
+
+    method enter_with_args(@pos, %named, :$next_dispatcher?) {
+        self.get_first($next_dispatcher)(|@pos, |%named)
+    }
+
+    method enter_with_capture($capture, :$next_dispatcher?) {
+        my $first := self.get_first($next_dispatcher);
+        nqp::invokewithcapture($first, $capture);
     }
 }