X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fmethinstaller-simple.t;h=3f8d33e13167dc794916d6e4ad875c6d99a9209b;hb=b52072dc659832e3465ecb4801024bc7c05ddad7;hp=c588beab13a6708c8e71f2db0b1ee63e0da15c02;hpb=b0a896321dc9c1d61dc59c4c1b32cb8f920123ca;p=p5sagit%2FDevel-Declare.git diff --git a/t/methinstaller-simple.t b/t/methinstaller-simple.t index c588bea..3f8d33e 100644 --- a/t/methinstaller-simple.t +++ b/t/methinstaller-simple.t @@ -1,3 +1,14 @@ +#!/usr/bin/perl -w + +use strict; +use Test::More; + +my $Have_Devel_BeginLift; +BEGIN { + # setup_for_cv() introduced in 0.001001 + $Have_Devel_BeginLift = eval q{ use Devel::BeginLift 0.001001; 1 }; +} + { package MethodHandlers; @@ -23,6 +34,17 @@ return $inject; } + sub code_for { + my($self, $name) = @_; + + my $code = $self->SUPER::code_for($name); + + if( defined $name and $Have_Devel_BeginLift ) { + Devel::BeginLift->setup_for_cv($code); + } + + return $code; + } } my ($test_method1, $test_method2, @test_list); @@ -37,6 +59,13 @@ my ($test_method1, $test_method2, @test_list); ); } + # Test at_BEGIN + SKIP: { + ::skip "Need Devel::BeginLift for compile time methods", 1 + unless $Have_Devel_BeginLift; + ::can_ok( "DeclareTest", qw(new foo upgrade) ); + } + method new { my $class = ref $self || $self; return bless({ @_ }, $class); @@ -66,10 +95,9 @@ my ($test_method1, $test_method2, @test_list); @test_list = (method { 1 }, sub { 2 }, method () { 3 }, sub { 4 }); - method leftie :lvalue { $self->{attributes} }; + method leftie($left) : method { $self->{left} ||= $left; $self->{left} }; } -use Test::More 'no_plan'; my $o = DeclareTest->new(attr => "value"); @@ -81,7 +109,7 @@ is($o->foo('yay'), 'DeclareTest: Foo: yay', 'method with argument ok'); is($o->main, 'main', 'declaration of package named method ok'); -$o->leftie = 'attributes work'; +$o->leftie( 'attributes work' ); is($o->leftie, 'attributes work', 'code attributes intact'); $o->upgrade; @@ -96,3 +124,4 @@ is($o->$test_method2('this'), 'DeclareTest2, this', 'anon method with proto ok') is_deeply([ map { $_->() } @test_list ], [ 1, 2, 3, 4], 'binding ok'); +done_testing;