From: Dave Rolsky <autarch@urth.org>
Date: Mon, 7 Jun 2010 16:35:50 +0000 (-0500)
Subject: Native counter methods now check that attribute is an integer and confess if it isn't
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Fattic%2Fnative-methods-useful-errors;p=gitmo%2FMoose.git

Native counter methods now check that attribute is an integer and confess if it isn't
---

diff --git a/lib/Moose/Meta/Attribute/Native/MethodProvider/Counter.pm b/lib/Moose/Meta/Attribute/Native/MethodProvider/Counter.pm
index 18e228a..d28051d 100644
--- a/lib/Moose/Meta/Attribute/Native/MethodProvider/Counter.pm
+++ b/lib/Moose/Meta/Attribute/Native/MethodProvider/Counter.pm
@@ -2,10 +2,23 @@
 package Moose::Meta::Attribute::Native::MethodProvider::Counter;
 use Moose::Role;
 
+use Scalar::Util qw( looks_like_number );
+
 our $VERSION   = '1.07';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
+sub _get_number {
+    my $val = $_[1]->( $_[0] );
+
+    unless ( defined $val && looks_like_number($val) && $val == int($val) ) {
+        local $Carp::CarpLevel += 3;
+        confess 'The ' . $_[2] . ' attribute does not contain an integer';
+    }
+
+    return $val;
+}
+
 sub reset : method {
     my ( $attr, $reader, $writer ) = @_;
     return sub { $writer->( $_[0], $attr->default( $_[0] ) ) };
@@ -18,17 +31,19 @@ sub set : method {
 
 sub inc {
     my ( $attr, $reader, $writer ) = @_;
+    my $name = $attr->name;
     return sub {
         $writer->( $_[0],
-            $reader->( $_[0] ) + ( defined( $_[1] ) ? $_[1] : 1 ) );
+            _get_number( $_[0], $reader, $name ) + ( defined( $_[1] ) ? $_[1] : 1 ) );
     };
 }
 
 sub dec {
     my ( $attr, $reader, $writer ) = @_;
+    my $name = $attr->name;
     return sub {
         $writer->( $_[0],
-            $reader->( $_[0] ) - ( defined( $_[1] ) ? $_[1] : 1 ) );
+            _get_number( $_[0], $reader, $name ) - ( defined( $_[1] ) ? $_[1] : 1 ) );
     };
 }
 
diff --git a/t/070_native_traits/201_trait_counter.t b/t/070_native_traits/201_trait_counter.t
index adb745f..ae9b5bc 100644
--- a/t/070_native_traits/201_trait_counter.t
+++ b/t/070_native_traits/201_trait_counter.t
@@ -3,6 +3,7 @@
 use strict;
 use warnings;
 
+use Test::Exception;
 use Test::More;
 use Test::Moose 'does_ok';
 
@@ -20,7 +21,8 @@ use Test::Moose 'does_ok';
             dec_counter   => 'dec',
             reset_counter => 'reset',
             set_counter   => 'set'
-        }
+        },
+        clearer => '_clear_counter',
     );
 }
 
@@ -76,4 +78,12 @@ is_deeply(
     '... got the right handles methods'
 );
 
+$page->_clear_counter;
+
+for my $meth (qw( inc_counter dec_counter )) {
+    throws_ok { $page->$meth() }
+    qr{^\QThe counter attribute does not contain an integer at \E.+\Q201_trait_counter.t line \E\d+},
+        "$meth dies with useful error";
+}
+
 done_testing;