From 17c4b9d73f59dbde3062c8517f200cd05ac3d8a1 Mon Sep 17 00:00:00 2001
From: jnthn <jnthn@jnthn.net>
Date: Mon, 17 Aug 2009 18:16:51 +0200
Subject: [PATCH] Make .HOW on a role give back the metaclass, rather than pun
 the role and give back the metaclass of the punned class. Correcting this
 also required fixing something that relied on the old broken behavior.

---
 src/builtins/guts.pir | 21 ++++++++++++++-------
 src/pmc/p6role.pmc    |  2 ++
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/src/builtins/guts.pir b/src/builtins/guts.pir
index d8b0001e952..9d453048f07 100644
--- a/src/builtins/guts.pir
+++ b/src/builtins/guts.pir
@@ -264,15 +264,18 @@ to find a real, non-subtype and stash that away for fast access later.
     real_type = refinee
   got_real_type:
 
-    # If it's an un-disambiguated role, dis-ambiguate.
-    $I0 = isa real_type, 'Perl6Role'
+    # Create subclass. If it's a role, pun it.
+    .local pmc parrot_class, type_obj, subset
+    type_obj = refinee
+    $I0 = isa type_obj, 'Perl6Role'
+    unless $I0 goto ambig_role_done
+    type_obj = type_obj.'!select'()
+  ambig_role_done:
+    $I0 = isa type_obj, 'P6role'
     unless $I0 goto role_done
-    real_type = real_type.'!select'()
+    type_obj = type_obj.'!pun'()
   role_done:
-
-    # Create subclass.
-    .local pmc parrot_class, subset
-    parrot_class = p6meta.'get_parrotclass'(refinee)
+    parrot_class = p6meta.'get_parrotclass'(type_obj)
     subset = subclass parrot_class
 
     # Override accepts.
@@ -291,6 +294,10 @@ to find a real, non-subtype and stash that away for fast access later.
     subset = p6meta.'register'(subset)
 
     # Mark it a subtype and stash away real type, refinee  and refinement.
+    $I0 = isa real_type, 'Perl6Role'
+    unless $I0 goto real_type_done
+    real_type = real_type.'!select'()
+  real_type_done:
     setprop subset, 'subtype_realtype', real_type
     setprop subset, 'subtype_refinement', refinement
     setprop subset, 'subtype_refinee', refinee
diff --git a/src/pmc/p6role.pmc b/src/pmc/p6role.pmc
index bbce2c6c263..94bfa7f56c1 100644
--- a/src/pmc/p6role.pmc
+++ b/src/pmc/p6role.pmc
@@ -39,6 +39,8 @@ pmclass P6role extends Role need_ext dynpmc group perl6_group {
             return SUPER(name);
         if (Parrot_str_equal(interp, name, CONST_STRING(interp, "Scalar")))
             return SUPER(name);
+        if (Parrot_str_equal(interp, name, CONST_STRING(interp, "HOW")))
+            return SUPER(name);
         first_char = Parrot_str_substr(interp, name, 0, 1, NULL, 0);
         if (Parrot_str_equal(interp, first_char, CONST_STRING(interp, "!")))
             return SUPER(name);