From b22982bb3ead5eacc7fb6e2eded4925784d225e5 Mon Sep 17 00:00:00 2001
From: jnthn <jnthn@jnthn.net>
Date: Wed, 9 Jan 2013 23:43:10 +0100
Subject: [PATCH] Fix $obj.Some::Role::meth(...).

Previously, it did not convey the correct self, since it relied on the
punning mechanism, which must invoke on the pun. Now it's fixed to do
the right thing.
---
 src/Perl6/Metamodel/ClassHOW.pm               | 14 +++++++++++++-
 src/Perl6/Metamodel/MROBasedMethodDispatch.pm | 13 +++++++++++++
 src/core/Mu.pm                                |  2 +-
 3 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/src/Perl6/Metamodel/ClassHOW.pm b/src/Perl6/Metamodel/ClassHOW.pm
index d17cfa65db3..60d32dc808e 100644
--- a/src/Perl6/Metamodel/ClassHOW.pm
+++ b/src/Perl6/Metamodel/ClassHOW.pm
@@ -21,6 +21,7 @@ class Perl6::Metamodel::ClassHOW
 {
     has @!roles;
     has @!role_typecheck_list;
+    has @!concretizations;
     has @!fallbacks;
     has $!composed;
     
@@ -87,7 +88,9 @@ class Perl6::Metamodel::ClassHOW
                 my $r := @roles_to_compose.pop();
                 @!roles[+@!roles] := $r;
                 @!role_typecheck_list[+@!role_typecheck_list] := $r;
-                @ins_roles.push($r.HOW.specialize($r, $obj))
+                my $ins := $r.HOW.specialize($r, $obj);
+                @ins_roles.push($ins);
+                nqp::push(@!concretizations, [$r, $ins]);
             }
             self.compute_mro($obj); # to the best of our knowledge, because the role applier wants it.
             RoleToClassApplier.apply($obj, @ins_roles);
@@ -185,6 +188,15 @@ class Perl6::Metamodel::ClassHOW
         @!role_typecheck_list
     }
     
+    method concretization($obj, $ptype) {
+        for @!concretizations {
+            if pir::perl6_decontainerize__PP($_[0]) =:= pir::perl6_decontainerize__PP($ptype) {
+                return $_[1];
+            }
+        }
+        nqp::die("No concretization found for " ~ $ptype.HOW.name($ptype));
+    }
+    
     method is_composed($obj) {
         $!composed
     }
diff --git a/src/Perl6/Metamodel/MROBasedMethodDispatch.pm b/src/Perl6/Metamodel/MROBasedMethodDispatch.pm
index 57a6703c5d6..63000bc2381 100644
--- a/src/Perl6/Metamodel/MROBasedMethodDispatch.pm
+++ b/src/Perl6/Metamodel/MROBasedMethodDispatch.pm
@@ -18,6 +18,19 @@ role Perl6::Metamodel::MROBasedMethodDispatch {
             nqp::null();
     }
     
+    method find_method_qualified($obj, $qtype, $name) {
+        if $qtype.HOW.archetypes.parametric && nqp::can(self, 'concretization') {
+            # Resolve it via the concrete form of this parametric.
+            my $conc := self.concretization($obj, $qtype);
+            $conc.HOW.method_table($conc){$name}
+        }
+        else {
+            # Non-parametric, so just locate it from the already concrete
+            # type (or fallback to this if no .concretization on ourself).
+            nqp::findmethod($qtype, $name)
+        }
+    }
+    
     method publish_method_cache($obj) {
         # Walk MRO and add methods to cache, unless another method
         # lower in the class hierarchy "shadowed" it.
diff --git a/src/core/Mu.pm b/src/core/Mu.pm
index 814539d48ab..1d108d22c22 100644
--- a/src/core/Mu.pm
+++ b/src/core/Mu.pm
@@ -315,7 +315,7 @@ my class Mu {
 
             ).throw;
         }
-        nqp::findmethod($type, $name)(SELF, |c)
+        self.HOW.find_method_qualified(self, $type, $name)(SELF, |c)
     }
     
     method dispatch:<!>(Mu \SELF: $name, Mu $type, |c) is rw is hidden_from_backtrace {