From: matthewt <matthewt@bd8105ee-0ff8-0310-8827-fb3f25b6796d>
Date: Fri, 9 Nov 2007 07:22:28 +0000 (+0000)
Subject: stop using & prototypes at all
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a8f404dc0714f2880f84629ebeb1fbaea919ae9;p=p5sagit%2FDevel-Declare.git

stop using & prototypes at all

git-svn-id: http://dev.catalyst.perl.org/repos/bast/trunk/Devel-Declare@3867 bd8105ee-0ff8-0310-8827-fb3f25b6796d
---

diff --git a/Changes b/Changes
index 0a9d7f2..594bf20 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Changes for Devel-Declare
 
+  - stop using & prototypes at all
+
 0.001004
   - correct idiotic typo if ifndef
 
diff --git a/lib/Devel/Declare.pm b/lib/Devel/Declare.pm
index 8349890..2e1d443 100644
--- a/lib/Devel/Declare.pm
+++ b/lib/Devel/Declare.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use 5.008001;
 
-our $VERSION = '0.001003';
+our $VERSION = '0.001004';
 
 # mirrored in Declare.xs as DD_HANDLE_*
 
@@ -120,7 +120,11 @@ sub build_sub_installer {
     package ${pack};
     my \$body;
     sub ${name} (${proto}) :lvalue {\n"
-    .'my $ret = $body->(@_);
+    .'  if (wantarray) {
+        my @ret = $body->(@_);
+        return @ret;
+      }
+      my $ret = $body->(@_);
       return $ret;
     };
     sub { ($body) = @_; };';
@@ -142,22 +146,19 @@ sub setup_declarators {
     $sub_proto =~ s/;//; $sub_proto = ';'.$sub_proto;
     #my $installer = $class->build_sub_installer($pack, $name, $proto);
     my $installer = $class->build_sub_installer($pack, $name, '@');
-    my $proto_maker = eval q!
-      sub {
-        my $body = shift;
-        sub (!.$sub_proto.q!) {
-          $body->(@_);
-        };
-      };
-    !;
     $installer->(sub :lvalue {
+#{ no warnings 'uninitialized'; warn 'INST: '.join(', ', @_)."\n"; }
       if (@_) {
         if (ref $_[0] eq 'HASH') {
           shift;
+          if (wantarray) {
+            my @ret = $run->(undef, undef, @_);
+            return @ret;
+          }
           my $r = $run->(undef, undef, @_);
           return $r;
         } else {
-          return $_[1];
+          return @_[1..$#_];
         }
       }
       return my $sv;
@@ -167,19 +168,19 @@ sub setup_declarators {
       sub {
         my ($usepack, $use, $inpack, $name, $proto) = @_;
         my $extra_code = $compile->($name, $proto);
-        my $main_handler = $proto_maker->(sub {
+        my $shift_hashref = defined(wantarray);
+        my $main_handler = sub { shift if $shift_hashref;
           ("DONE", $run->($name, $proto, @_));
-        });
+        };
         my ($name_h, $XX);
         if (defined $proto) {
           $name_h = sub :lvalue { return my $sv; };
           $XX = $main_handler;
         } elsif (defined $name && length $name) {
           $name_h = $main_handler;
-        } else {
-          $extra_code ||= '';
-          $extra_code = '}, sub {'.$extra_code;
         }
+        $extra_code ||= '';
+        $extra_code = '}, sub {'.$extra_code;
         return ($name_h, $XX, $extra_code);
       }
     ];
diff --git a/t/sugar.t b/t/sugar.t
index 4ca64e6..8b51917 100644
--- a/t/sugar.t
+++ b/t/sugar.t
@@ -6,11 +6,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 +22,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;
@@ -54,6 +58,8 @@ my ($test_method1, $test_method2);
     return join(', ', ref $self, $what);
   };
 
+  @test_list = method { 1 }, sub { 2 }, method () { 3 }, sub { 4 };
+
 }
 
 use Test::More 'no_plan';
@@ -75,3 +81,5 @@ 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;