From: Zefram <zefram@fysh.org>
Date: Sun, 11 Sep 2011 17:31:30 +0000 (+0100)
Subject: prevent toke_scan_str moving backward in linestr
X-Git-Tag: 0.006007~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-Declare.git;a=commitdiff_plain;h=78bb475dd0c334ce6f507f501d7b9e1d8cbd8b0b

prevent toke_scan_str moving backward in linestr
---

diff --git a/Changes b/Changes
index ceded56..59531b0 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,8 @@ Changes for Devel-Declare
 
   - Depend on B::Hooks::OP::Check version 0.19, which fixes a serious bug in
     how it interacts with other modules that hook ops.
+  - Adjust toke_scan_str logic to always show a positive effective length of
+    string source.
   - Detect and croak if unwanted reallocation occurs during toke_scan_str.
   - Avoid memory leak in toke_scan_str.
   - Add MYMETA.{json,yml} to MANIFEST.SKIP and .gitignore.
diff --git a/Declare.xs b/Declare.xs
index 3f1728a..e36668d 100644
--- a/Declare.xs
+++ b/Declare.xs
@@ -219,18 +219,16 @@ int dd_toke_scan_ident(pTHX_ int offset) {
 
 int dd_toke_scan_str(pTHX_ int offset) {
   char* old_pvx = SvPVX(PL_linestr);
-  STRLEN remaining = sv_len(PL_linestr) - offset;
   SV* line_copy = sv_2mortal(newSVsv(PL_linestr));
   char* base_s = SvPVX(PL_linestr) + offset;
   char* s = scan_str(base_s, FALSE, FALSE);
   if(SvPVX(PL_linestr) != old_pvx)
     croak("PL_linestr reallocated during scan_str, "
       "Devel::Declare can't continue");
-  if (s != base_s && sv_len(PL_lex_stuff) > remaining) {
-    int ret = (s - SvPVX(PL_linestr)) + remaining;
+  if (s <= base_s) {
+    s += SvCUR(line_copy);
     sv_catsv(line_copy, PL_linestr);
     dd_set_linestr(aTHX_ SvPV_nolen(line_copy));
-    return ret;
   }
   return s - base_s;
 }
diff --git a/lib/Devel/Declare.pm b/lib/Devel/Declare.pm
index 553065c..ed29686 100644
--- a/lib/Devel/Declare.pm
+++ b/lib/Devel/Declare.pm
@@ -513,8 +513,21 @@ things like C<q(this is a quote)>).
 
 Also it Does The Right Thing with nested delimiters (like C<q(this (is (a) quote))>).
 
-It returns the length of the expression matched.  Use C<get_lex_stuff> to
-get the actual matched text.
+It returns the effective length of the expression matched.  Really, what
+it returns is the difference in position between where the string started,
+within the buffer, and where it finished.  If the string extended across
+multiple lines then the contents of the buffer may have been completely
+replaced by the new lines, so this position difference is not the same
+thing as the actual length of the expression matched.  However, because
+moving backward in the buffer causes problems, the function arranges
+for the effective length to always be positive, padding the start of
+the buffer if necessary.
+
+Use C<get_lex_stuff> to get the actual matched text, the content of
+the string.  Because of the behaviour around multiline strings, you
+can't reliably get this from the buffer.  In fact, after the function
+returns, you can't rely on any content of the buffer preceding the end
+of the string.
 
 =head4 C<get_lex_stuff>
 
diff --git a/t/scanstr.t b/t/scanstr.t
new file mode 100644
index 0000000..3344b8d
--- /dev/null
+++ b/t/scanstr.t
@@ -0,0 +1,71 @@
+use warnings;
+use strict;
+
+use Devel::Declare ();
+use Test::More tests => 10;
+
+sub my_quote($) { $_[0] }
+
+sub my_quote_parser {
+  my($declarator, $offset) = @_;
+  $offset += Devel::Declare::toke_move_past_token($offset);
+  $offset += Devel::Declare::toke_skipspace($offset);
+  my $len = Devel::Declare::toke_scan_str($offset);
+  my $content = Devel::Declare::get_lex_stuff();
+  Devel::Declare::clear_lex_stuff();
+  my $linestr = Devel::Declare::get_linestr();
+  die "suprising len=$len" if $len <= 0;
+  $content =~ s/(.)/sprintf("\\x{%x}", ord($1))/seg;
+  substr $linestr, $offset, $len, "(\"$content\")";
+  Devel::Declare::set_linestr($linestr);
+}
+
+BEGIN {
+  Devel::Declare->setup_for(__PACKAGE__, {
+    my_quote => { const => \&my_quote_parser },
+  });
+}
+
+my $x;
+
+$x = my_quote[foo];
+is $x, "foo";
+
+$x = my_quote[foo
+];
+is $x, "foo\n";
+
+$x = my_quote[foo
+x];
+is $x, "foo\nx";
+
+$x = my_quote[foo
+xy];
+is $x, "foo\nxy";
+
+$x = my_quote[foo
+xyz];
+is $x, "foo\nxyz";
+
+$x = my_quote[foo
+bar baz quux];
+is $x, "foo\nbar baz quux";
+
+$x = my_quote[foo
+bar baz quuux];
+is $x, "foo\nbar baz quuux";
+
+$x = my_quote[foo
+bar baz quuuux];
+is $x, "foo\nbar baz quuuux";
+
+$x = my_quote[foo
+bar baz quux wibble];
+is $x, "foo\nbar baz quux wibble";
+
+$x = my_quote[foo
+quux
+womble];
+is $x, "foo\nquux\nwomble";
+
+1;