t/001_mouse/032-buildargs.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 11;
   5 use Test::Exception;
   6
   7 {
   8     package C;
   9     use Mouse;
  10 }
  11
  12 # original BUILDARGS
  13
  14 is_deeply( C->BUILDARGS(), {} );
  15 is_deeply( C->BUILDARGS(foo => 42), {foo => 42} );
  16 is_deeply( C->BUILDARGS(foo => 42, foo => 'bar'), {foo => 'bar'} );
  17 is_deeply( C->BUILDARGS({foo => 1, bar => 2}), {foo => 1, bar => 2} );
  18
  19 my %hash = (foo => 10);
  20 my $args = C->BUILDARGS(\%hash);
  21 $args->{foo}++;
  22 is $hash{foo}, 10, 'values must be copied';
  23
  24 %hash = (foo => 10);
  25 $args = C->BUILDARGS(%hash);
  26 $args->{foo}++;
  27 is $hash{foo}, 10, 'values must be copied';
  28
  29 throws_ok {
  30     C->BUILDARGS([]);
  31 } qr/must be a HASH ref/;
  32
  33
  34 throws_ok {
  35     C->BUILDARGS([]);
  36 } qr/must be a HASH ref/;
  37
  38
  39 # custom BUILDARGS
  40
  41 do {
  42     package Foo;
  43     use Mouse;
  44
  45     has foo => ( is => "rw" );
  46
  47     sub BUILDARGS {
  48         my ( $self, @args ) = @_;
  49         return { @args % 2 ? ( foo => @args ) : @args };
  50     }
  51 };
  52
  53 is(Foo->new->foo, undef, "no value");
  54 is(Foo->new("bar")->foo, "bar", "single arg");
  55 is(Foo->new(foo => "bar")->foo, "bar", "twoargs");
  56