Heray-Was-Here
Server : Apache
System : Linux vps103298.mylogin.co 4.18.0-513.11.1.el8_9.x86_64 #1 SMP Wed Jan 17 02:00:40 EST 2024 x86_64
User : calvet ( 273824)
PHP Version : 7.4.33
Disable Function : NONE
Directory :  /usr/share/doc/perl-Mouse/t/001_mouse/

Upload File :
current_dir [ Writeable ] document_root [ Writeable ]

 

Current File : //usr/share/doc/perl-Mouse/t/001_mouse/032-buildargs.t
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 11;
use Test::Exception;

{
    package C;
    use Mouse;
}

# original BUILDARGS

is_deeply( C->BUILDARGS(), {} );
is_deeply( C->BUILDARGS(foo => 42), {foo => 42} );
is_deeply( C->BUILDARGS(foo => 42, foo => 'bar'), {foo => 'bar'} );
is_deeply( C->BUILDARGS({foo => 1, bar => 2}), {foo => 1, bar => 2} );

my %hash = (foo => 10);
my $args = C->BUILDARGS(\%hash);
$args->{foo}++;
is $hash{foo}, 10, 'values must be copied';

%hash = (foo => 10);
$args = C->BUILDARGS(%hash);
$args->{foo}++;
is $hash{foo}, 10, 'values must be copied';

throws_ok {
    C->BUILDARGS([]);
} qr/must be a HASH ref/;


throws_ok {
    C->BUILDARGS([]);
} qr/must be a HASH ref/;


# custom BUILDARGS

do {
    package Foo;
    use Mouse;

    has foo => ( is => "rw" );

    sub BUILDARGS {
        my ( $self, @args ) = @_;
        return { @args % 2 ? ( foo => @args ) : @args };
    }
};

is(Foo->new->foo, undef, "no value");
is(Foo->new("bar")->foo, "bar", "single arg");
is(Foo->new(foo => "bar")->foo, "bar", "twoargs");


Hry