implement &samecase

rakudo · Jul 24, 2011 · e5d914c · e5d914c
1 parent 5ee5857
commit e5d914c
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 2 deletions.
diff --git a/src/core/Cool.pm b/src/core/Cool.pm
@@ -98,6 +98,7 @@ my class Cool {
 
     method sprintf(*@args) { sprintf(self, @args) };
     method printf (*@args) {  printf(self, @args) };
+    method samecase(Cool:D: Cool $pattern) { self.Stringy.samecase($pattern) }
 }
 
 sub chop($s)                  { $s.chop }
@@ -130,3 +131,4 @@ sub sprintf(Cool $format, *@args) {
 }
 
 sub printf(Cool $format, *@args) { print sprintf $format, @args };
+sub samecase(Cool $string, Cool $pattern) { $string.samecase($pattern) }
diff --git a/src/core/Str.pm b/src/core/Str.pm
@@ -332,6 +332,20 @@ my class Str does Stringy {
             Nil;
         }
     }
+
+    method samecase(Str:D: Str $pattern) {
+        my @chars;
+        my @pat = $pattern.comb;
+        my $p = '';
+        for self.comb -> $s {
+            $p = @pat.shift if @pat;
+            # XXX anchors necessary due to a regex bug
+            push @chars, $p ~~ /^<.upper>$/  ?? $s.uc
+                      !! $p ~~ /^<.lower>$/  ?? $s.lc
+                      !! $s;
+        }
+        @chars.join('');
+    }
 }
 
 

diff --git a/t/spectest.data b/t/spectest.data
@@ -541,7 +541,7 @@ S32-str/flip.t
 # S32-str/indent.t # err: Method 'blocktype' not found for invocant of class 'PAST;Op' # icu 
 # S32-str/index.t # err: dies after test # 2
 S32-str/lc.t                                               # icu
-S32-str/lcfirst.t                                            # icu
+S32-str/lcfirst.t                                          # icu
 S32-str/lines.t
 S32-str/numeric.t
 S32-str/ords.t
@@ -550,7 +550,7 @@ S32-str/ords.t
 # S32-str/pack.t # err: Could not find sub &pack
 S32-str/pos.t
 S32-str/rindex.t
-# S32-str/samecase.t # err: Could not find sub &samecase # icu
+S32-str/samecase.t                                         # icu
 # S32-str/split-simple.t # err: too many positional arguments: 3 passed, 1 expected
 # S32-str/split.t # err: too many positional arguments: 3 passed, 1 expected
 S32-str/sprintf.t