Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

check attribute coercion

Test if an attribute should coerce or not.
  • Loading branch information...
commit a6a0df5897f29e1b37b1a3ebf72143beec952ac4 1 parent 7ea7a71
@RsrchBoy authored
Showing with 85 additions and 0 deletions.
  1. +8 −0 lib/Test/Moose/More.pm
  2. +77 −0 t/attribute/coerce.t
View
8 lib/Test/Moose/More.pm
@@ -535,6 +535,14 @@ sub _attribute_options_ok {
;
}
+ if (exists $opts{coerce}) {
+
+ delete $opts{coerce}
+ ? ok( $att->should_coerce, "$thing_name should coerce")
+ : ok(!$att->should_coerce, "$thing_name should not coerce")
+ ;
+ }
+
for my $opt (sort keys %opts) {
do { fail "unknown attribute option: $opt"; next }
View
77 t/attribute/coerce.t
@@ -0,0 +1,77 @@
+use strict;
+use warnings;
+
+use Test::Builder::Tester;
+use Test::More;
+use Test::Moose::More;
+use TAP::SimpleOutput 'counters';
+
+{
+ package TestRole;
+ use Moose::Role;
+ use Moose::Deprecated -api_version => '1.07'; # don't complain
+ use namespace::autoclean;
+
+ has yes_coerce => (is => 'ro', isa => 'Str', coerce => 1);
+ has no_coerce => (is => 'ro', isa => 'Str', coerce => 0);
+ has null_coerce => (is => 'ro', isa => 'Str');
+}
+{
+ package TestClass;
+ use Moose;
+ use Moose::Deprecated -api_version => '1.07'; # don't complain
+ use namespace::autoclean;
+
+ has yes_coerce => (is => 'ro', isa => 'Str', coerce => 1);
+ has no_coerce => (is => 'ro', isa => 'Str', coerce => 0);
+ has null_coerce => (is => 'ro', isa => 'Str');
+}
+
+note 'finds coercion correctly';
+for my $thing (qw{ TestClass TestRole }) {
+ my ($_ok, $_nok, $_skip) = counters();
+ my $name = 'yes_coerce';
+ test_out $_ok->("$thing has an attribute named $name");
+ test_out $_ok->("$name should coerce");
+ test_out $_ok->("$thing has an attribute named $name");
+ test_out $_nok->("$name should not coerce");
+ test_fail 7;
+ test_out $_ok->("$thing has an attribute named $name");
+ test_out $_nok->("$name should not coerce");
+ test_fail 7;
+ validate_attribute $thing => $name => (
+ coerce => 1,
+ );
+ validate_attribute $thing => $name => (
+ coerce => 0,
+ );
+ validate_attribute $thing => $name => (
+ coerce => undef,
+ );
+ test_test "finds coercion correctly in $thing";
+}
+
+note 'finds no coercion correctly';
+for my $thing (qw{ TestClass TestRole}) {
+ my ($_ok, $_nok, $_skip) = counters();
+ my $name = 'no_coerce';
+ test_out $_ok->("$thing has an attribute named $name");
+ test_out $_nok->("$name should coerce");
+ test_fail 5;
+ test_out $_ok->("$thing has an attribute named $name");
+ test_out $_ok->("$name should not coerce");
+ test_out $_ok->("$thing has an attribute named $name");
+ test_out $_ok->("$name should not coerce");
+ validate_attribute $thing => $name => (
+ coerce => 1,
+ );
+ validate_attribute $thing => $name => (
+ coerce => 0,
+ );
+ validate_attribute $thing => $name => (
+ coerce => undef,
+ );
+ test_test "finds no coercion correctly in $thing";
+}
+
+done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.