t/020_attributes/006_attribute_required.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 15;
   7 use Test::Exception;
   8
   9
  10
  11 {
  12     package Foo;
  13     use Mouse;
  14
  15     has 'bar' => (is => 'ro', required => 1);
  16     has 'baz' => (is => 'rw',  default => 100, required => 1);
  17     has 'boo' => (is => 'rw', lazy => 1, default => 50, required => 1);
  18 }
  19
  20 {
  21     my $foo = Foo->new(bar => 10, baz => 20, boo => 100);
  22     isa_ok($foo, 'Foo');
  23
  24     is($foo->bar, 10, '... got the right bar');
  25     is($foo->baz, 20, '... got the right baz');
  26     is($foo->boo, 100, '... got the right boo');
  27 }
  28
  29 {
  30     my $foo = Foo->new(bar => 10, boo => 5);
  31     isa_ok($foo, 'Foo');
  32
  33     is($foo->bar, 10, '... got the right bar');
  34     is($foo->baz, 100, '... got the right baz');
  35     is($foo->boo, 5, '... got the right boo');
  36 }
  37
  38 {
  39     my $foo = Foo->new(bar => 10);
  40     isa_ok($foo, 'Foo');
  41
  42     is($foo->bar, 10, '... got the right bar');
  43     is($foo->baz, 100, '... got the right baz');
  44     is($foo->boo, 50, '... got the right boo');
  45 }
  46
  47 #Yeah.. this doesn't work like this anymore, see below. (groditi)
  48 #throws_ok {
  49 #    Foo->new(bar => 10, baz => undef);
  50 #} qr/^Attribute \(baz\) is required and cannot be undef/, '... must supply all the required attribute';
  51
  52 #throws_ok {
  53 #    Foo->new(bar => 10, boo => undef);
  54 #} qr/^Attribute \(boo\) is required and cannot be undef/, '... must supply all the required attribute';
  55
  56 lives_ok {
  57     Foo->new(bar => 10, baz => undef);
  58 } '... undef is a valid attribute value';
  59
  60 lives_ok {
  61     Foo->new(bar => 10, boo => undef);
  62 }  '... undef is a valid attribute value';
  63
  64
  65 throws_ok {
  66     Foo->new;
  67 } qr/^Attribute \(bar\) is required/, '... must supply all the required attribute';
  68