From: Rhesa Rozendaal <rhesa@cpan.org>
Date: Fri, 24 Oct 2008 11:43:49 +0000 (+0000)
Subject: ctx-simple: integrated multiline proto handling from M::S
X-Git-Tag: 0.005000~47^2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=refs%2Fheads%2Fcontext_object;p=p5sagit%2FDevel-Declare.git

ctx-simple: integrated multiline proto handling from M::S
---

diff --git a/lib/Devel/Declare/Context/Simple.pm b/lib/Devel/Declare/Context/Simple.pm
index 7b0f740..474025a 100644
--- a/lib/Devel/Declare/Context/Simple.pm
+++ b/lib/Devel/Declare/Context/Simple.pm
@@ -5,7 +5,6 @@ use B::Hooks::EndOfScope;
 use strict;
 use warnings;
 
-sub DEBUG { warn "@_" }
 sub new {
   my $class = shift;
   bless {@_}, $class;
@@ -30,14 +29,26 @@ sub skipspace {
   $self->offset += Devel::Declare::toke_skipspace( $self->offset );
 }
 
+sub get_linestr {
+  my $self = shift;
+  my $line = Devel::Declare::get_linestr();
+  return $line;
+}
+
+sub set_linestr {
+  my $self = shift;
+  my ($line) = @_;
+  Devel::Declare::set_linestr($line);
+}
+
 sub strip_name {
   my $self = shift;
   $self->skipspace;
   if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) {
-    my $linestr = Devel::Declare::get_linestr();
+    my $linestr = $self->get_linestr();
     my $name = substr( $linestr, $self->offset, $len );
     substr( $linestr, $self->offset, $len ) = '';
-    Devel::Declare::set_linestr($linestr);
+    $self->set_linestr($linestr);
     return $name;
   }
 
@@ -49,17 +60,25 @@ sub strip_proto {
   my $self = shift;
   $self->skipspace;
 
-  my $linestr = Devel::Declare::get_linestr();
+  my $linestr = $self->get_linestr();
   if (substr($linestr, $self->offset, 1) eq '(') {
     my $length = Devel::Declare::toke_scan_str($self->offset);
-    my $proto  = Devel::Declare::get_lex_stuff();
+    my $proto = Devel::Declare::get_lex_stuff();
     Devel::Declare::clear_lex_stuff();
-    $linestr = Devel::Declare::get_linestr();
+    if( $length < 0 ) {
+      # Need to scan ahead more
+      $linestr .= $self->get_linestr();
+      $length = rindex($linestr, ")") - $self->offset + 1;
+    }
+    else {
+      $linestr = $self->get_linestr();
+    }
+
     substr($linestr, $self->offset, $length) = '';
-    Devel::Declare::set_linestr($linestr);
+    $self->set_linestr($linestr);
+
     return $proto;
   }
-
   return;
 }
 
@@ -80,11 +99,11 @@ sub inject_if_block {
 
   $self->skipspace;
 
-  my $linestr = Devel::Declare::get_linestr;
+  my $linestr = $self->get_linestr;
   if (substr($linestr, $self->offset, 1) eq '{') {
     substr($linestr, $self->offset + 1, 0) = $inject;
     substr($linestr, $self->offset, 0) = $before;
-    Devel::Declare::set_linestr($linestr);
+    $self->set_linestr($linestr);
   }
 }
 
diff --git a/t/ctx-simple.t b/t/ctx-simple.t
index 938afc7..14f80f4 100644
--- a/t/ctx-simple.t
+++ b/t/ctx-simple.t
@@ -15,6 +15,7 @@ use Devel::Declare ();
     my ($proto) = @_;
     my $inject = 'my ($self';
     if (defined $proto) {
+      $proto =~ s/[\r\n\s]+/ /g;
       $inject .= ", $proto" if length($proto);
       $inject .= ') = @_; ';
     } else {
@@ -88,6 +89,23 @@ my ($test_method1, $test_method2, @test_list);
 
   @test_list = (method { 1 }, sub { 2 }, method () { 3 }, sub { 4 });
 
+  method multiline1(
+  $foo
+  )
+  {
+    return "$foo$foo";
+  }
+
+  method multiline2(
+    $foo, $bar
+  ) { return "$foo $bar"; }
+
+  method 
+    multiline3 ($foo,
+        $bar) {
+    return "$bar $foo";
+  }
+
 }
 
 use Test::More 'no_plan';
@@ -102,6 +120,10 @@ is($o->foo('yay'), 'DeclareTest: Foo: yay', 'method with argument ok');
 
 is($o->main, 'main', 'declaration of package named method ok');
 
+is($o->multiline1(3), '33', 'multiline1 proto ok');
+is($o->multiline2(1,2), '1 2', 'multiline2 proto ok');
+is($o->multiline3(4,5), '5 4', 'multiline3 proto ok');
+
 $o->upgrade;
 
 isa_ok($o, 'DeclareTest2');
@@ -114,19 +136,3 @@ is($o->$test_method2('this'), 'DeclareTest2, this', 'anon method with proto ok')
 
 is_deeply([ map { $_->() } @test_list ], [ 1, 2, 3, 4], 'binding ok');
 
-__END__
-/home/rhesa/perl/t/method-no-semi....
-ok 1 - The object isa DeclareTest
-ok 2 - @_ args ok
-ok 3 - method with argument ok
-ok 4 - declaration of package named method ok
-ok 5 - The object isa DeclareTest2
-ok 6 - absolute method declaration ok
-ok 7 - anon method with @_ ok
-ok 8 - anon method with proto ok
-ok 9 - binding ok
-1..9
-ok
-All tests successful.
-Files=1, Tests=9,  0 wallclock secs ( 0.04 usr  0.00 sys +  0.05 cusr  0.00 csys =  0.09 CPU)
-Result: PASS