Commit | Line | Data |
633048d5 |
1 | #!perl |
2 | use warnings FATAL => 'all'; |
3 | use strict; |
4 | use Test::More 'no_plan'; |
5 | |
6 | { |
7 | package Foo; |
8 | use Function::Parameters qw(:strict); |
9 | |
10 | method new (%args) { |
11 | return bless {%args}, $self; |
12 | } |
13 | |
14 | method set ($key, $val) { |
15 | return $self->{$key} = $val; |
16 | } |
17 | |
18 | method get ($key) { |
19 | return $self->{$key}; |
20 | } |
21 | |
22 | method no_proto { |
23 | return($self, @_); |
24 | } |
25 | |
26 | method empty_proto() { |
27 | return($self, @_); |
28 | } |
29 | |
30 | method echo(@_) { |
31 | return($self, @_); |
32 | } |
33 | |
34 | method caller($height = 0) { |
35 | return (CORE::caller($height))[0..2]; |
36 | } |
37 | |
38 | #line 39 |
39 | method warn($foo = undef) { |
40 | my $warning = ''; |
41 | local $SIG{__WARN__} = sub { $warning = join '', @_; }; |
42 | CORE::warn "Testing warn"; |
43 | |
44 | return $warning; |
45 | } |
46 | |
47 | # Method with the same name as a loaded class. |
48 | method strict () { |
49 | 42 |
50 | } |
51 | } |
52 | |
53 | my $obj = Foo->new( foo => 42, bar => 23 ); |
54 | isa_ok $obj, "Foo"; |
55 | is $obj->get("foo"), 42; |
56 | is $obj->get("bar"), 23; |
57 | |
58 | $obj->set(foo => 99); |
59 | is $obj->get("foo"), 99; |
60 | |
61 | is_deeply [$obj->no_proto], [$obj]; |
62 | for my $method (qw(empty_proto)) { |
63 | is_deeply [$obj->$method], [$obj]; |
64 | ok !eval { $obj->$method(23); 1 }; |
65 | like $@, qr{\QToo many arguments}; |
66 | } |
67 | |
68 | is_deeply [$obj->echo(1,2,3)], [$obj,1,2,3], "echo"; |
69 | |
70 | is_deeply [$obj->caller], [__PACKAGE__, $0, __LINE__], 'caller works'; |
71 | |
72 | is $obj->warn, "Testing warn at $0 line 42.\n"; |
73 | |
74 | is eval { $obj->strict }, 42; |