0.1.5 changes
matthewt [Mon, 26 Nov 2007 20:47:44 +0000 (20:47 +0000)]
git-svn-id: http://dev.catalyst.perl.org/repos/bast/trunk/Devel-Declare@3893 bd8105ee-0ff8-0310-8827-fb3f25b6796d

Changes
Declare.xs
lib/Devel/Declare.pm
t/sugar.t

diff --git a/Changes b/Changes
index 594bf20..3534464 100644 (file)
--- a/Changes
+++ b/Changes
@@ -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
index 9737f09..4b66c31 100644 (file)
@@ -208,12 +208,14 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o) {
     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);
index 2e1d443..de3c3f5 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use 5.008001;
 
-our $VERSION = '0.001004';
+our $VERSION = '0.001005';
 
 # mirrored in Declare.xs as DD_HANDLE_*
 
@@ -121,8 +121,7 @@ sub build_sub_installer {
     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 @@ sub setup_declarators {
     $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, @_));
         };
index dffca84..0f1b685 100644 (file)
--- a/t/sugar.t
+++ b/t/sugar.t
@@ -58,7 +58,7 @@ my ($test_method1, $test_method2, @test_list);
     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 };
 
 }