From: Florian Ragwitz <rafl@debian.org>
Date: Fri, 8 Apr 2011 03:18:34 +0000 (+0200)
Subject: Re-instate linestr growing using filters
X-Git-Tag: 0.006002~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12b60feb8cd262c1a8eb72e671daaa5cf7449966;p=p5sagit%2FDevel-Declare.git

Re-instate linestr growing using filters

This way very early linestr re-allocations will continue to work as they did
before. However, we still don't support growing within the first line that
loaded Devel::Declare.
---

diff --git a/Declare.xs b/Declare.xs
index 934f8f6..e5d0e50 100644
--- a/Declare.xs
+++ b/Declare.xs
@@ -379,6 +379,8 @@ STATIC OP *dd_ck_entereval(pTHX_ OP *o, void *user_data) {
   return o;
 }
 
+#endif /* !DD_GROW_VIA_BLOCKHOOK */
+
 static I32 dd_filter_realloc(pTHX_ int idx, SV *sv, int maxlen)
 {
   const I32 count = FILTER_READ(idx+1, sv, maxlen);
@@ -387,8 +389,6 @@ static I32 dd_filter_realloc(pTHX_ int idx, SV *sv, int maxlen)
   return count;
 }
 
-#endif /* !DD_GROW_VIA_BLOCKHOOK */
-
 static int dd_handle_const(pTHX_ char *name) {
   switch (PL_lex_inwhat) {
     case OP_QR:
@@ -500,9 +500,7 @@ setup()
     hook_op_check(OP_CONST, dd_ck_const, NULL);
 #endif /* !DD_CONST_VIA_RV2CV */
   }
-#if !DD_GROW_VIA_BLOCKHOOK
   filter_add(dd_filter_realloc, NULL);
-#endif /* !DD_GROW_VIA_BLOCKHOOK */
 
 char*
 get_linestr()
diff --git a/t/early0.t b/t/early0.t
new file mode 100644
index 0000000..2f5c94f
--- /dev/null
+++ b/t/early0.t
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+BEGIN {
+    require Devel::Declare;
+    Devel::Declare->setup_for(__PACKAGE__, {
+        class => {
+            const => sub {
+                my ($kw, $off) = @_;
+                $off += Devel::Declare::toke_move_past_token($off);
+                $off += Devel::Declare::toke_skipspace($off);
+                die unless substr(Devel::Declare::get_linestr(), $off, 1) eq '{';
+                my $l = Devel::Declare::get_linestr();
+                substr $l, $off + 1, 0, 'pass q[injected];' . (';' x 1000);
+                Devel::Declare::set_linestr($l);
+                my $class = sub (&) { $_[0]->() };
+                no strict 'refs';
+                *{ $kw } = $class;
+            },
+        },
+    });
+}
+class {};
diff --git a/t/early1.t b/t/early1.t
new file mode 100644
index 0000000..7bd08c4
--- /dev/null
+++ b/t/early1.t
@@ -0,0 +1,5 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+use t::early1_x;
+class {};
diff --git a/t/early1_x.pm b/t/early1_x.pm
new file mode 100644
index 0000000..89dc1cb
--- /dev/null
+++ b/t/early1_x.pm
@@ -0,0 +1,25 @@
+package t::early1_x;
+use strict;
+use warnings;
+sub import {
+    require Devel::Declare;
+    my $caller = caller();
+    Devel::Declare->setup_for($caller, {
+        class => {
+            const => sub {
+                my ($kw, $off) = @_;
+                $off += Devel::Declare::toke_move_past_token($off);
+                $off += Devel::Declare::toke_skipspace($off);
+                die unless substr(Devel::Declare::get_linestr(), $off, 1) eq '{';
+                my $l = Devel::Declare::get_linestr();
+                substr $l, $off + 1, 0, 'pass q[injected];' . (';' x 1000);
+                Devel::Declare::set_linestr($l);
+                my $class = sub (&) { $_[0]->() };
+                no strict 'refs';
+                *{ "${caller}::$kw" } = $class;
+            },
+        },
+    });
+}
+
+1;