From: Rhesa Rozendaal Date: Sat, 25 Oct 2008 10:32:32 +0000 (+0000) Subject: using :lvalue subs breaks the debugger, so I added a inc_offset method to Context... X-Git-Tag: 0.005000~45 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ab449c2e81bf76bdd7348c6a1a10a25a70093dff;p=p5sagit%2FDevel-Declare.git using :lvalue subs breaks the debugger, so I added a inc_offset method to Context::Simple --- diff --git a/lib/Devel/Declare/Context/Simple.pm b/lib/Devel/Declare/Context/Simple.pm index 474025a..174e072 100644 --- a/lib/Devel/Declare/Context/Simple.pm +++ b/lib/Devel/Declare/Context/Simple.pm @@ -13,20 +13,32 @@ sub new { sub init { my $self = shift; @{$self}{ qw(Declarator Offset) } = @_; - $self; + return $self; } -sub offset : lvalue { shift->{Offset}; } -sub declarator { shift->{Declarator} } +sub offset { + my $self = shift; + return $self->{Offset} +} + +sub inc_offset { + my $self = shift; + $self->{Offset} += shift; +} + +sub declarator { + my $self = shift; + return $self->{Declarator} +} sub skip_declarator { my $self = shift; - $self->offset += Devel::Declare::toke_move_past_token( $self->offset ); + $self->inc_offset(Devel::Declare::toke_move_past_token($self->offset)); } sub skipspace { my $self = shift; - $self->offset += Devel::Declare::toke_skipspace( $self->offset ); + $self->inc_offset(Devel::Declare::toke_skipspace($self->offset)); } sub get_linestr { @@ -87,7 +99,7 @@ sub get_curstash_name { } sub shadow { - my $self = shift; + my $self = shift; my $pack = $self->get_curstash_name; Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] ); } diff --git a/lib/Devel/Declare/MethodInstaller/Simple.pm b/lib/Devel/Declare/MethodInstaller/Simple.pm index 96fa88c..9a11911 100644 --- a/lib/Devel/Declare/MethodInstaller/Simple.pm +++ b/lib/Devel/Declare/MethodInstaller/Simple.pm @@ -26,36 +26,34 @@ sub strip_attrs { my $self = shift; $self->skipspace; - my $Offset = $self->offset; my $linestr = Devel::Declare::get_linestr; my $attrs = ''; - if (substr($linestr, $Offset, 1) eq ':') { - while (substr($linestr, $Offset, 1) ne '{') { - if (substr($linestr, $Offset, 1) eq ':') { - substr($linestr, $Offset, 1) = ''; + if (substr($linestr, $self->offset, 1) eq ':') { + while (substr($linestr, $self->offset, 1) ne '{') { + if (substr($linestr, $self->offset, 1) eq ':') { + substr($linestr, $self->offset, 1) = ''; Devel::Declare::set_linestr($linestr); $attrs .= ':'; } $self->skipspace; - $Offset = $self->offset; $linestr = Devel::Declare::get_linestr(); - if (my $len = Devel::Declare::toke_scan_word($Offset, 0)) { - my $name = substr($linestr, $Offset, $len); - substr($linestr, $Offset, $len) = ''; + if (my $len = Devel::Declare::toke_scan_word($self->offset, 0)) { + my $name = substr($linestr, $self->offset, $len); + substr($linestr, $self->offset, $len) = ''; Devel::Declare::set_linestr($linestr); $attrs .= " ${name}"; - if (substr($linestr, $Offset, 1) eq '(') { - my $length = Devel::Declare::toke_scan_str($Offset); + if (substr($linestr, $self->offset, 1) eq '(') { + my $length = Devel::Declare::toke_scan_str($self->offset); my $arg = Devel::Declare::get_lex_stuff(); Devel::Declare::clear_lex_stuff(); $linestr = Devel::Declare::get_linestr(); - substr($linestr, $Offset, $length) = ''; + substr($linestr, $self->offset, $length) = ''; Devel::Declare::set_linestr($linestr); $attrs .= "(${arg})"; diff --git a/t/methinstaller-simple.t b/t/methinstaller-simple.t index c588bea..62400ee 100644 --- a/t/methinstaller-simple.t +++ b/t/methinstaller-simple.t @@ -66,7 +66,7 @@ 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'; @@ -81,7 +81,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;