[Bast-commits] r3753 - in trunk/Devel-Declare: lib/Devel t

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2007-09-17 02:10:55 +0100 (Mon, 17 Sep 2007)
New Revision: 3753

Modified:
   trunk/Devel-Declare/lib/Devel/Declare.pm
   trunk/Devel-Declare/t/sugar.t
Log:
made method { ... }; work

Modified: trunk/Devel-Declare/lib/Devel/Declare.pm
===================================================================
--- trunk/Devel-Declare/lib/Devel/Declare.pm	2007-09-17 00:43:15 UTC (rev 3752)
+++ trunk/Devel-Declare/lib/Devel/Declare.pm	2007-09-17 01:10:55 UTC (rev 3753)
@@ -151,8 +151,14 @@
       };
     !;
     $installer->(sub :lvalue {
-      if (@_) { warn @_;
-        $run->(undef, undef, @_);
+      if (@_) {
+        if (ref $_[0] eq 'HASH') {
+          shift;
+          my $r = $run->(undef, undef, @_);
+          return $r;
+        } else {
+          return $_[1];
+        }
       }
       return my $sv;
     });
@@ -162,14 +168,17 @@
         my ($usepack, $use, $inpack, $name, $proto) = @_;
         my $extra_code = $compile->($name, $proto);
         my $main_handler = $proto_maker->(sub {
-          $run->($name, $proto, @_);
+          ("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 {
-          $name_h = $main_handler;
+          $extra_code ||= '';
+          $extra_code = '}, sub {'.$extra_code;
         }
         return ($name_h, $XX, $extra_code);
       }

Modified: trunk/Devel-Declare/t/sugar.t
===================================================================
--- trunk/Devel-Declare/t/sugar.t	2007-09-17 00:43:15 UTC (rev 3752)
+++ trunk/Devel-Declare/t/sugar.t	2007-09-17 01:10:55 UTC (rev 3753)
@@ -46,7 +46,7 @@
     return 'DeclareTest2: bar';
   };
 
-  $test_method1 = method (@_) {
+  $test_method1 = method {
     return join(', ', $self->{attr}, $_[1]);
   };