3 package MethodHandlers;
7 use base 'Devel::Declare::MethodInstaller::Simple';
9 # undef -> my ($self) = shift;
10 # '' -> my ($self) = @_;
11 # '$foo' -> my ($self, $foo) = @_;
16 my $inject = 'my ($self';
18 $inject .= ", $proto" if length($proto);
19 $inject .= ') = @_; ';
21 $inject .= ') = shift;';
28 my ($test_method1, $test_method2, @test_list);
33 BEGIN { # normally, this'd go in MethodHandlers::import
34 MethodHandlers->install_methodhandler(
41 my $class = ref $self || $self;
42 return bless({ @_ }, $class);
46 return (ref $self).': Foo: '.$foo;
49 method upgrade(){ # no spaces to make case pathological
50 bless($self, 'DeclareTest2');
53 method DeclareTest2::bar () {
54 return 'DeclareTest2: bar';
57 $test_method1 = method {
58 return join(', ', $self->{attr}, $_[1]);
61 $test_method2 = method ($what) {
62 return join(', ', ref $self, $what);
65 method main () { return "main"; }
67 @test_list = (method { 1 }, sub { 2 }, method () { 3 }, sub { 4 });
71 use Test::More 'no_plan';
73 my $o = DeclareTest->new(attr => "value");
75 isa_ok($o, 'DeclareTest');
77 is($o->{attr}, 'value', '@_ args ok');
79 is($o->foo('yay'), 'DeclareTest: Foo: yay', 'method with argument ok');
81 is($o->main, 'main', 'declaration of package named method ok');
85 isa_ok($o, 'DeclareTest2');
87 is($o->bar, 'DeclareTest2: bar', 'absolute method declaration ok');
89 is($o->$test_method1('no', 'yes'), 'value, yes', 'anon method with @_ ok');
91 is($o->$test_method2('this'), 'DeclareTest2, this', 'anon method with proto ok');
93 is_deeply([ map { $_->() } @test_list ], [ 1, 2, 3, 4], 'binding ok');
96 /home/rhesa/perl/t/methinstaller-simple....
97 ok 1 - The object isa DeclareTest
99 ok 3 - method with argument ok
100 ok 4 - declaration of package named method ok
101 ok 5 - The object isa DeclareTest2
102 ok 6 - absolute method declaration ok
103 ok 7 - anon method with @_ ok
104 ok 8 - anon method with proto ok
108 All tests successful.
109 Files=1, Tests=9, 0 wallclock secs ( 0.04 usr 0.00 sys + 0.05 cusr 0.00 csys = 0.09 CPU)