properly handle unicode in upper/lowercase types

diff --git a/Changes b/Changes
index bd302b9..e9b56fc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,8 @@ Revision history for {{$dist->name}}
 {{$NEXT}}
   - converted to Dist::Zilla
   - SingleDigit now supports zero and negative numbers (RT#86738)
+  - UpperCase and LowerCase string types now properly understand unicode
+    characters (RT#84547)
 
 0.001008   2012-06-14 11:29:50 PDT
   - Upper* and Lower* string types now accept non-alphabetic characters (Karen

diff --git a/lib/MooseX/Types/Common/String.pm b/lib/MooseX/Types/Common/String.pm
index ac1f37a..218b826 100644 (file)
--- a/lib/MooseX/Types/Common/String.pm
+++ b/lib/MooseX/Types/Common/String.pm
@@ -93,12 +93,12 @@ subtype NonEmptyStr,
 
 subtype LowerCaseStr,
   as NonEmptyStr,
-  where { !/[A-Z]/ms },
+  where { !/\p{Upper}/ms },
   message { "Must not contain upper case letters" },
     ( $Moose::VERSION >= 2.0200
         ? inline_as {
             $_[0]->parent()->_inline_check( $_[1] ) . ' && '
-                . qq{ ( $_[1] !~ /[A-Z]/ms ) };
+                . qq{ ( $_[1] !~ /\\p{Upper}/ms ) };
         }
         : ()
     );
@@ -109,12 +109,12 @@ coerce LowerCaseStr,
 
 subtype UpperCaseStr,
   as NonEmptyStr,
-  where { !/[a-z]/ms },
+  where { !/\p{Lower}/ms },
   message { "Must not contain lower case letters" },
     ( $Moose::VERSION >= 2.0200
         ? inline_as {
             $_[0]->parent()->_inline_check( $_[1] ) . ' && '
-                . qq{ ( $_[1] !~ m/[a-z]/ms ) };
+                . qq{ ( $_[1] !~ /\\p{Lower}/ms ) };
         }
         : ()
     );
@@ -125,12 +125,12 @@ coerce UpperCaseStr,
 
 subtype LowerCaseSimpleStr,
   as NonEmptySimpleStr,
-  where { !/[A-Z]/ },
+  where { !/\p{Upper}/ },
   message { "Must not contain upper case letters" },
     ( $Moose::VERSION >= 2.0200
         ? inline_as {
             $_[0]->parent()->_inline_check( $_[1] ) . ' && '
-                . qq{ ( $_[1] !~ m/[A-Z]/ ) };
+                . qq{ ( $_[1] !~ /\\p{Upper}/ ) };
         }
         : ()
     );
@@ -141,12 +141,12 @@ coerce LowerCaseSimpleStr,
 
 subtype UpperCaseSimpleStr,
   as NonEmptySimpleStr,
-  where { !/[a-z]/ },
+  where { !/\p{Lower}/ },
   message { "Must not contain lower case letters" },
     ( $Moose::VERSION >= 2.0200
         ? inline_as {
             $_[0]->parent()->_inline_check( $_[1] ) . ' && '
-                . qq{ ( $_[1] !~ m/[a-z]/ ) };
+                . qq{ ( $_[1] !~ /\\p{Lower}/ ) };
         }
         : ()
     );

diff --git a/t/05-unicode.t b/t/05-unicode.t
new file mode 100644 (file)
index 0000000..b8e2c83
--- /dev/null
+++ b/t/05-unicode.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings FATAL => 'all';
+
+use utf8;
+use open qw(:std :utf8);
+
+use Test::More;
+use if $ENV{AUTHOR_TESTING}, 'Test::Warnings';
+
+use MooseX::Types::Common::String -all;
+
+ok(  is_UpperCaseStr('CAFÉ'), q[CAFÉ is uppercase] );
+ok( !is_UpperCaseStr('CAFé'), q[CAFé is not (entirely) uppercase] );
+
+ok( !is_UpperCaseStr('ŐħĤăĩ'), q[ŐħĤăĩ not entirely uppercase] );
+ok( !is_LowerCaseStr('ŐħĤăĩ'), q[ŐħĤăĩ not entirely lowercase] );
+
+ok(  is_LowerCaseStr('café'), q[café is lowercase] );
+ok( !is_LowerCaseStr('cafÉ'), q[cafÉ is not (entirely) lowercase] );
+
+ok(  is_UpperCaseSimpleStr('CAFÉ'), q[CAFÉ is uppercase] );
+ok( !is_UpperCaseSimpleStr('CAFé'), q[CAFé is not (entirely) uppercase] );
+
+ok(  is_LowerCaseSimpleStr('café'), q[café is lowercase] );
+ok( !is_LowerCaseSimpleStr('cafÉ'), q[cafÉ is not (entirely) lowercase] );
+
+done_testing;