5 Devel::Declare->install_declarator(
6 'DeclareTest', 'method', DECLARE_PACKAGE | DECLARE_PROTO,
8 my ($name, $proto) = @_;
9 #no warnings 'uninitialized';
10 #warn "NP: ".join(', ', @_)."\n";
11 return 'my $self = shift;' unless defined $proto && $proto ne '@_';
12 return 'my ($self'.(length $proto ? ", ${proto}" : "").') = @_;';
15 my ($name, $proto, $sub, @rest) = @_;
16 #no warnings 'uninitialized';
17 #warn "NPS: ".join(', ', @_)."\n";
18 if (defined $name && length $name) {
19 unless ($name =~ /::/) {
20 $name = "DeclareTest::${name}";
25 return wantarray ? ($sub, @rest) : $sub;
31 my ($test_method1, $test_method2, @test_list);
37 my $class = ref $self || $self;
38 return bless({ @_ }, $class);
42 return (ref $self).': Foo: '.$foo;
45 method upgrade(){ # no spaces to make case pathological
46 bless($self, 'DeclareTest2');
49 method DeclareTest2::bar () {
50 return 'DeclareTest2: bar';
53 $test_method1 = method {
54 return join(', ', $self->{attr}, $_[1]);
57 $test_method2 = method ($what) {
58 return join(', ', ref $self, $what);
61 @test_list = method { 1 }, sub { 2 }, method () { 3 }, sub { 4 };
65 use Test::More 'no_plan';
67 my $o = DeclareTest->new(attr => "value");
69 isa_ok($o, 'DeclareTest');
71 is($o->{attr}, 'value', '@_ args ok');
73 is($o->foo('yay'), 'DeclareTest: Foo: yay', 'method with argument ok');
77 isa_ok($o, 'DeclareTest2');
79 is($o->bar, 'DeclareTest2: bar', 'absolute method declaration ok');
81 is($o->$test_method1('no', 'yes'), 'value, yes', 'anon method with @_ ok');
83 is($o->$test_method2('this'), 'DeclareTest2, this', 'anon method with proto ok');
85 #warn map { $_->() } @test_list;