t/017-default-reference.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 9;
   5 use Test::Exception;
   6
   7 do {
   8     package Class;
   9     use Mouse;
  10
  11     ::lives_ok {
  12         has a => (
  13             is => 'rw',
  14             default => sub { [1] },
  15         );
  16     };
  17
  18     ::lives_ok {
  19         has code => (
  20             is => 'rw',
  21             default => sub { sub { 1 } },
  22         );
  23     };
  24
  25     ::throws_ok {
  26         has b => (
  27             is => 'rw',
  28             default => [],
  29         );
  30     } qr/References are not allowed as default values/;
  31
  32     ::throws_ok {
  33         has c => (
  34             is => 'rw',
  35             default => {},
  36         );
  37     } qr/References are not allowed as default values/;
  38
  39     ::throws_ok {
  40         has d => (
  41             is => 'rw',
  42             default => Test::Builder->new,
  43         );
  44     } qr/References are not allowed as default values/;
  45 };
  46
  47 is(ref(Class->new->code), 'CODE', "default => sub { sub { 1 } } stuffs a coderef");
  48 is(Class->new->code->(), 1, "default => sub sub strips off the first coderef");
  49 is_deeply(Class->new->a, [1], "default of sub { reference } works");
  50
  51 do {
  52   package Class::Two;
  53   use Mouse;
  54   has foo => (is => 'rw', default => sub {
  55     die unless $_[0]->isa('Class::Two');
  56     shift->default_foo;
  57   });
  58   sub default_foo { 1 };
  59 };
  60
  61 my $obj2 = Class::Two->new;
  62 is($obj2->foo, 1, 'default method gets the $_[0] it needs to work');