X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fsugar.t;h=7cd4c54afb1b9b4b0e88a8af499e60a3a9070b62;hb=e8e28944ba0dbcaf478071464085b15c5104e104;hp=e71a9441a5a51d70ad53c0fd30e63280911b688b;hpb=86c3de80ef9a10529fedf92a7a52e4b379265123;p=p5sagit%2FDevel-Declare.git diff --git a/t/sugar.t b/t/sugar.t index e71a944..7cd4c54 100644 --- a/t/sugar.t +++ b/t/sugar.t @@ -1,3 +1,5 @@ +use strict; +use warnings; use Devel::Declare; BEGIN { @@ -6,11 +8,15 @@ BEGIN { 'DeclareTest', 'method', DECLARE_PACKAGE | DECLARE_PROTO, sub { my ($name, $proto) = @_; +#no warnings 'uninitialized'; +#warn "NP: ".join(', ', @_)."\n"; return 'my $self = shift;' unless defined $proto && $proto ne '@_'; return 'my ($self'.(length $proto ? ", ${proto}" : "").') = @_;'; }, sub { - my ($name, $proto, $sub) = @_; + my ($name, $proto, $sub, @rest) = @_; +#no warnings 'uninitialized'; +#warn "NPS: ".join(', ', @_)."\n"; if (defined $name && length $name) { unless ($name =~ /::/) { $name = "DeclareTest::${name}"; @@ -18,13 +24,13 @@ BEGIN { no strict 'refs'; *{$name} = $sub; } - return $sub; + return wantarray ? ($sub, @rest) : $sub; } ); } -my ($test_method1, $test_method2); +my ($test_method1, $test_method2, @test_list); { package DeclareTest; @@ -38,7 +44,7 @@ my ($test_method1, $test_method2); return (ref $self).': Foo: '.$foo; }; - method upgrade () { + method upgrade(){ # no spaces to make case pathological bless($self, 'DeclareTest2'); }; @@ -46,7 +52,7 @@ my ($test_method1, $test_method2); return 'DeclareTest2: bar'; }; - $test_method1 = method (@_) { + $test_method1 = method { return join(', ', $self->{attr}, $_[1]); }; @@ -54,9 +60,13 @@ my ($test_method1, $test_method2); return join(', ', ref $self, $what); }; + method main () { return "main"; }; + + #@test_list = method { 1 }, sub { 2 }, method () { 3 }, sub { 4 }; + } -use Test::More 'no_plan'; +use Test::More 0.88; my $o = DeclareTest->new(attr => "value"); @@ -66,6 +76,8 @@ is($o->{attr}, 'value', '@_ args ok'); is($o->foo('yay'), 'DeclareTest: Foo: yay', 'method with argument ok'); +is($o->main, 'main', 'declaration of package named method ok'); + $o->upgrade; isa_ok($o, 'DeclareTest2'); @@ -75,3 +87,7 @@ is($o->bar, 'DeclareTest2: bar', 'absolute method declaration ok'); is($o->$test_method1('no', 'yes'), 'value, yes', 'anon method with @_ ok'); is($o->$test_method2('this'), 'DeclareTest2, this', 'anon method with proto ok'); + +#warn map { $_->() } @test_list; + +done_testing;