Permalink
Browse files

implement &samecase

  • Loading branch information...
1 parent 5ee5857 commit e5d914c4ab3119e4d6464850fa5fa71eb64fa483 @moritz moritz committed Jul 24, 2011
Showing with 18 additions and 2 deletions.
  1. +2 −0 src/core/Cool.pm
  2. +14 −0 src/core/Str.pm
  3. +2 −2 t/spectest.data
View
@@ -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) }
View
@@ -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('');
+ }
}
View
@@ -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

0 comments on commit e5d914c

Please sign in to comment.