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

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2007-11-26 20:47:44 +0000 (Mon, 26 Nov 2007)
New Revision: 3893

Modified:
   trunk/Devel-Declare/Changes
   trunk/Devel-Declare/Declare.xs
   trunk/Devel-Declare/lib/Devel/Declare.pm
   trunk/Devel-Declare/t/sugar.t
Log:
0.1.5 changes

Modified: trunk/Devel-Declare/Changes
===================================================================
--- trunk/Devel-Declare/Changes	2007-11-25 16:26:57 UTC (rev 3892)
+++ trunk/Devel-Declare/Changes	2007-11-26 20:47:44 UTC (rev 3893)
@@ -1,5 +1,8 @@
 Changes for Devel-Declare
 
+0.001005
+  - nasty goto &$func hack to avoid :lvalue+list context weirdness
+  - correct SvGROW invocation
   - stop using & prototypes at all
 
 0.001004

Modified: trunk/Devel-Declare/Declare.xs
===================================================================
--- trunk/Devel-Declare/Declare.xs	2007-11-25 16:26:57 UTC (rev 3892)
+++ trunk/Devel-Declare/Declare.xs	2007-11-26 20:47:44 UTC (rev 3893)
@@ -208,12 +208,14 @@
     retstr = POPpx;
     PUTBACK;
     if (retstr && strlen(retstr)) {
+      const int old_len = SvCUR(PL_linestr);
 #ifdef DD_DEBUG
       printf("Got string %s\n", retstr);
 #endif
-      SvGROW(PL_linestr, strlen(retstr));
+      SvGROW(PL_linestr, (STRLEN)(old_len + strlen(retstr)));
       memmove(s+strlen(retstr), s, (PL_bufend - s)+1);
       memmove(s, retstr, strlen(retstr));
+      SvCUR_set(PL_linestr, old_len + strlen(retstr));
       PL_bufend += strlen(retstr);
 #ifdef DD_DEBUG
   printf("cur buf: %s\n", s);

Modified: trunk/Devel-Declare/lib/Devel/Declare.pm
===================================================================
--- trunk/Devel-Declare/lib/Devel/Declare.pm	2007-11-25 16:26:57 UTC (rev 3892)
+++ trunk/Devel-Declare/lib/Devel/Declare.pm	2007-11-26 20:47:44 UTC (rev 3893)
@@ -4,7 +4,7 @@
 use warnings;
 use 5.008001;
 
-our $VERSION = '0.001004';
+our $VERSION = '0.001005';
 
 # mirrored in Declare.xs as DD_HANDLE_*
 
@@ -121,8 +121,7 @@
     my \$body;
     sub ${name} (${proto}) :lvalue {\n"
     .'  if (wantarray) {
-        my @ret = $body->(@_);
-        return @ret;
+        goto &$body;
       }
       my $ret = $body->(@_);
       return $ret;
@@ -166,9 +165,8 @@
     $setup_for_args{$name} = [
       $flags,
       sub {
-        my ($usepack, $use, $inpack, $name, $proto) = @_;
+        my ($usepack, $use, $inpack, $name, $proto, $shift_hashref) = @_;
         my $extra_code = $compile->($name, $proto);
-        my $shift_hashref = defined(wantarray);
         my $main_handler = sub { shift if $shift_hashref;
           ("DONE", $run->($name, $proto, @_));
         };

Modified: trunk/Devel-Declare/t/sugar.t
===================================================================
--- trunk/Devel-Declare/t/sugar.t	2007-11-25 16:26:57 UTC (rev 3892)
+++ trunk/Devel-Declare/t/sugar.t	2007-11-26 20:47:44 UTC (rev 3893)
@@ -58,7 +58,7 @@
     return join(', ', ref $self, $what);
   };
 
-  @test_list = method { 1 }, sub { 2 }, method () { 3 }, sub { 4 };
+  #@test_list = method { 1 }, sub { 2 }, method () { 3 }, sub { 4 };
 
 }