Merge branch 'master' of git@github.com:rakudo/rakudo

rakudo · Apr 18, 2009 · 27b0b76 · 27b0b76
2 parents 063c0f2 + 6739243
commit 27b0b76
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 3 deletions.
diff --git a/src/classes/Role.pir b/src/classes/Role.pir
@@ -101,7 +101,8 @@ Selects a variant of the role to do based upon the supplied parameters.
     .return (result)
   it_loop_end:
 
-    # First time we've had these parameters, so need to instantiate them.
+    # First time we've had these parameters, so need to create the role
+    # taking them.
   select_role:
     .local pmc selector
     selector = getattribute self, '$!selector'
@@ -110,6 +111,11 @@ Selects a variant of the role to do based upon the supplied parameters.
     ins_hash["pos_args"] = pos_args
     ins_hash["role"] = result
     push created_list, ins_hash
+
+    # Also need to annotate that role with its parameters and the "factory"
+    # that generated it.
+    setprop result, "$!owner", self
+    setprop result, "@!type_args", pos_args
     .return (result)
 .end
 
@@ -245,6 +251,12 @@ Puns the role to a class and returns that class.
     # I/someone has the energy for it.
     '!compose_role_attributes'(metaclass, self)
     proto = p6meta.'register'(metaclass, 'parent'=>'Any')
+    
+    # Set name (don't use name=>... in register so we don't make a
+    # namespace entry though).
+    $P0 = self.'Str'()
+    $P1 = proto.'HOW'()
+    setattribute $P1, 'shortname', $P0
 
     # Stash it away, then instantiate it.
     setprop self, '$!pun', proto
@@ -288,8 +300,9 @@ Puns the role to a class and returns that class.
 =cut
 
 .sub 'Str' :method :vtable('get_string')
-    $P0 = getprop '$!shortname', self
-    .return ($P0)
+    $P0 = getprop '$!owner', self
+    $S0 = $P0
+    .return ($S0)
 .end
 
 =back

diff --git a/src/setting/Any-str.pm b/src/setting/Any-str.pm
@@ -58,6 +58,21 @@ class Any is also {
         $char
     }
 
+    our Str multi method samecase(Str $pattern) is export {
+        my @pattern = $pattern.split('');
+        [~] gather {
+            my $p = "";
+            for (~self).split('') -> $s {
+                $p = @pattern.shift if @pattern;
+                given $p {
+                    when /<upper>/ { take $s.uc }
+                    when /<lower>/ { take $s.lc }
+                    default { take $s }
+                }
+            }
+        }
+    }
+
     our List multi method split(Code $delimiter, $limit = *) {
         my $s = ~self;
         my $l = $limit ~~ Whatever ?? Inf !! $limit;

diff --git a/t/spectest.data b/t/spectest.data
@@ -375,6 +375,7 @@ S32-str/p5chomp.t
 S32-str/p5chop.t
 S32-str/pos.t
 S32-str/rindex.t
+S32-str/samecase.t
 S32-str/split-simple.t
 S32-str/sprintf.t
 S32-str/substr.t