7 Devel::Declare->install_declarator(
8 'DeclareTest', 'method', DECLARE_PACKAGE | DECLARE_PROTO,
10 my ($name, $proto) = @_;
11 #no warnings 'uninitialized';
12 #warn "NP: ".join(', ', @_)."\n";
13 return 'my $self = shift;' unless defined $proto && $proto ne '@_';
14 return 'my ($self'.(length $proto ? ", ${proto}" : "").') = @_;';
17 my ($name, $proto, $sub, @rest) = @_;
18 #no warnings 'uninitialized';
19 #warn "NPS: ".join(', ', @_)."\n";
20 if (defined $name && length $name) {
21 unless ($name =~ /::/) {
22 $name = "DeclareTest::${name}";
27 return wantarray ? ($sub, @rest) : $sub;
33 my ($test_method1, $test_method2, @test_list);
39 my $class = ref $self || $self;
40 return bless({ @_ }, $class);
44 return (ref $self).': Foo: '.$foo;
47 method upgrade(){ # no spaces to make case pathological
48 bless($self, 'DeclareTest2');
51 method DeclareTest2::bar () {
52 return 'DeclareTest2: bar';
55 $test_method1 = method {
56 return join(', ', $self->{attr}, $_[1]);
59 $test_method2 = method ($what) {
60 return join(', ', ref $self, $what);
63 method main () { return "main"; };
65 #@test_list = method { 1 }, sub { 2 }, method () { 3 }, sub { 4 };
71 my $o = DeclareTest->new(attr => "value");
73 isa_ok($o, 'DeclareTest');
75 is($o->{attr}, 'value', '@_ args ok');
77 is($o->foo('yay'), 'DeclareTest: Foo: yay', 'method with argument ok');
79 is($o->main, 'main', 'declaration of package named method ok');
83 isa_ok($o, 'DeclareTest2');
85 is($o->bar, 'DeclareTest2: bar', 'absolute method declaration ok');
87 is($o->$test_method1('no', 'yes'), 'value, yes', 'anon method with @_ ok');
89 is($o->$test_method2('this'), 'DeclareTest2, this', 'anon method with proto ok');
91 #warn map { $_->() } @test_list;