added tests for attribute shortcuts
Christian Walde [Wed, 28 Mar 2012 12:08:22 +0000 (14:08 +0200)]
t/accessor-default.t
t/accessor-pred-clear.t
t/accessor-shortcuts.t [new file with mode: 0644]
t/accessor-trigger.t

index 1f3fbac..3c02d75 100644 (file)
@@ -14,6 +14,8 @@ use Test::More;
   has four => (is => 'ro', builder => '_build_four');
   sub _build_four { {} }
   has five => (is => 'ro', init_arg => undef, default => sub { {} });
+  has six => (is => 'ro', builder => 1);
+  sub _build_six { {} }
 }
 
 sub check {
@@ -34,4 +36,6 @@ check four => map Foo->new->{four}, 1..2;
 
 check five => map Foo->new->{five}, 1..2;
 
+check six => map Foo->new->{six}, 1..2;
+
 done_testing;
index 4f73321..e8f5cbf 100644 (file)
@@ -6,20 +6,27 @@ use Test::More;
 
   use Moo;
 
-  has one => (
-    is => 'ro', lazy => 1, default => sub { 3 },
-    predicate => 'has_one', clearer => 'clear_one'
-  );
+  my @params = (is => 'ro', lazy => 1, default => sub { 3 });
+
+  has one => (@params, predicate => 'has_one', clearer => 'clear_one');
+
+  has $_ => (@params, clearer => 1, predicate => 1) for qw( bar _bar );
 }
 
 my $foo = Foo->new;
 
-ok(!$foo->has_one, 'empty');
-is($foo->one, 3, 'lazy default');
-ok($foo->has_one, 'not empty now');
-is($foo->clear_one, 3, 'clearer returns value');
-ok(!$foo->has_one, 'clearer empties');
-is($foo->one, 3, 'default re-fired');
-ok($foo->has_one, 'not empty again');
+for ( qw( one bar _bar ) ) {
+  my ($lead, $middle) = ('_' x /^_/, '_' x !/^_/);
+  my $predicate = $lead . "has$middle$_";
+  my $clearer   = $lead . "clear$middle$_";
+
+  ok(!$foo->$predicate, 'empty');
+  is($foo->$_, 3, 'lazy default');
+  ok($foo->$predicate, 'not empty now');
+  is($foo->$clearer, 3, 'clearer returns value');
+  ok(!$foo->$predicate, 'clearer empties');
+  is($foo->$_, 3, 'default re-fired');
+  ok($foo->$predicate, 'not empty again');
+}
 
 done_testing;
diff --git a/t/accessor-shortcuts.t b/t/accessor-shortcuts.t
new file mode 100644 (file)
index 0000000..ef6e7fc
--- /dev/null
@@ -0,0 +1,49 @@
+use strictures 1;
+use Test::More;
+use Test::Fatal;
+
+my $test         = "test";
+my $lazy_default = "lazy_default";
+
+{
+  package Foo;
+
+  use Moo;
+
+  has rwp  => (is => 'rwp');
+  has lazy => (is => 'lazy');
+  sub _build_lazy    { $test }
+  has lazy_default => (is => 'lazy', default => sub { $lazy_default });
+}
+
+my $foo = Foo->new;
+
+# rwp
+{
+  is $foo->rwp, undef, "rwp value starts out undefined";
+  like exception { $foo->rwp($test) }, qr/Usage: Foo::rwp\(self\)/, "rwp is read_only";
+  is exception { $foo->_set_rwp($test) }, undef, "rwp can be set by writer";
+  is $foo->rwp, $test, "rwp value was set by writer";
+}
+
+# lazy
+{
+  is $foo->{lazy}, undef, "lazy value storage is undefined";
+  is $foo->lazy, $test, "lazy value returns test value when called";
+  like exception { $foo->lazy($test) }, qr/Usage: Foo::lazy\(self\)/, "lazy is read_only";
+
+  my $foo_with_args = Foo->new(lazy => $test);
+  is $foo_with_args->{lazy}, undef, "lazy ignores constructor value";
+}
+
+# lazy + default
+{
+  is $foo->{lazy_default}, undef, "lazy_default value storage is undefined";
+  is $foo->lazy_default, $lazy_default, "lazy_default value returns test value when called";
+  like exception { $foo->lazy_default($test) }, qr/Usage: Foo::lazy\(self\)/, "lazy_default is read_only";
+
+  my $foo_with_args = Foo->new(lazy_default => $test);
+  is $foo_with_args->{lazy_default}, undef, "lazy_default ignores constructor value";
+}
+
+done_testing;
index 4728395..aaef959 100644 (file)
@@ -93,4 +93,16 @@ run_for 'Default';
 
 run_for 'LazyDefault';
 
+{
+  package Shaz;
+
+  use Moo;
+
+  has one => (is => 'rw', trigger => 1 );
+
+  sub _one_trigger { push @::tr, $_[1] }
+}
+
+run_for 'Shaz';
+
 done_testing;