Commit | Line | Data |
a17be455 |
1 | use strictures 1; |
2 | use Test::More; |
3 | |
4 | { |
5 | package Qux; |
6 | use Moo; |
7 | |
8 | has bar => ( is => "rw" ); |
9 | has baz => ( is => "rw" ); |
10 | |
11 | package Quux; |
12 | use Moo; |
13 | |
14 | extends qw(Qux); |
15 | } |
16 | { |
17 | package Foo; |
18 | use Moo; |
19 | |
20 | has bar => ( is => "rw" ); |
21 | has baz => ( is => "rw" ); |
22 | |
23 | sub BUILDARGS { |
24 | my ( $class, @args ) = @_; |
25 | unshift @args, "bar" if @args % 2 == 1; |
26 | return $class->SUPER::BUILDARGS(@args); |
27 | } |
28 | |
29 | package Bar; |
30 | use Moo; |
31 | |
32 | extends qw(Foo); |
33 | } |
34 | |
35 | { |
36 | package Baz; |
37 | use Moo; |
38 | |
39 | has bar => ( is => "rw" ); |
40 | has baz => ( is => "rw" ); |
41 | |
42 | around BUILDARGS => sub { |
43 | my $orig = shift; |
44 | my ( $class, @args ) = @_; |
45 | |
46 | unshift @args, "bar" if @args % 2 == 1; |
47 | |
48 | return $class->$orig(@args); |
49 | }; |
50 | |
51 | package Biff; |
52 | use Moo; |
53 | |
54 | extends qw(Baz); |
55 | } |
56 | |
57 | foreach my $class (qw(Foo Bar Baz Biff)) { |
58 | is( $class->new->bar, undef, "no args" ); |
59 | is( $class->new( bar => 42 )->bar, 42, "normal args" ); |
60 | is( $class->new( 37 )->bar, 37, "single arg" ); |
61 | { |
62 | my $o = $class->new(bar => 42, baz => 47); |
63 | is($o->bar, 42, '... got the right bar'); |
64 | is($o->baz, 47, '... got the right baz'); |
65 | } |
66 | { |
67 | my $o = $class->new(42, baz => 47); |
68 | is($o->bar, 42, '... got the right bar'); |
69 | is($o->baz, 47, '... got the right baz'); |
70 | } |
71 | } |
72 | |
73 | foreach my $class (qw(Qux Quux)) { |
74 | my $o = $class->new(bar => 42, baz => 47); |
75 | is($o->bar, 42, '... got the right bar'); |
76 | is($o->baz, 47, '... got the right baz'); |
77 | |
78 | eval { |
79 | $class->new( 37 ); |
80 | }; |
81 | like( $@, qr/Single parameters to new\(\) must be a HASH ref/, |
82 | "new() requires a list or a HASH ref" |
83 | ); |
84 | |
85 | eval { |
86 | $class->new( [ 37 ] ); |
87 | }; |
88 | like( $@, qr/Single parameters to new\(\) must be a HASH ref/, |
89 | "new() requires a list or a HASH ref" |
90 | ); |
91 | } |
92 | |
93 | done_testing; |
94 | |