toke_scan_str return undef for unterminated string

diff --git a/Changes b/Changes
index 59531b0..98e6e9f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,7 @@ Changes for Devel-Declare
     how it interacts with other modules that hook ops.
   - Adjust toke_scan_str logic to always show a positive effective length of
     string source.
+  - Return undef from toke_scan_str if string was unterminated.
   - 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 e36668d..65902ff 100644 (file)
--- a/Declare.xs
+++ b/Declare.xs
@@ -225,6 +225,8 @@ int dd_toke_scan_str(pTHX_ int offset) {
   if(SvPVX(PL_linestr) != old_pvx)
     croak("PL_linestr reallocated during scan_str, "
       "Devel::Declare can't continue");
+  if (!s)
+    return 0;
   if (s <= base_s) {
     s += SvCUR(line_copy);
     sv_catsv(line_copy, PL_linestr);
@@ -563,10 +565,13 @@ toke_move_past_token(int offset);
   OUTPUT:
     RETVAL
 
-int
+SV*
 toke_scan_str(int offset);
+  PREINIT:
+    int len;
   CODE:
-    RETVAL = dd_toke_scan_str(aTHX_ offset);
+    len = dd_toke_scan_str(aTHX_ offset);
+    RETVAL = len ? newSViv(len) : &PL_sv_undef;
   OUTPUT:
     RETVAL
 

diff --git a/lib/Devel/Declare.pm b/lib/Devel/Declare.pm
index ed29686..3f3eb76 100644 (file)
--- a/lib/Devel/Declare.pm
+++ b/lib/Devel/Declare.pm
@@ -529,6 +529,10 @@ 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.
 
+If the string being scanned is not well formed (has no closing delimiter),
+C<toke_scan_str> returns C<undef>.  In this case you cannot rely on the
+contents of the buffer.
+
 =head4 C<get_lex_stuff>
 
 This builtin returns what was matched by C<toke_scan_str>.  To avoid segfaults,

diff --git a/lib/Devel/Declare/Context/Simple.pm b/lib/Devel/Declare/Context/Simple.pm
index 51a2d05..8ea318e 100644 (file)
--- a/lib/Devel/Declare/Context/Simple.pm
+++ b/lib/Devel/Declare/Context/Simple.pm
@@ -110,7 +110,8 @@ sub strip_proto {
     Devel::Declare::clear_lex_stuff();
     $linestr = $self->get_linestr();
 
-    substr($linestr, $self->offset, $length) = '';
+    substr($linestr, $self->offset,
+      defined($length) ? $length : length($linestr)) = '';
     $self->set_linestr($linestr);
 
     return $proto;

diff --git a/t/scanstr.t b/t/scanstr.t
index 3344b8d..3c0d0f2 100644 (file)
--- a/t/scanstr.t
+++ b/t/scanstr.t
@@ -14,7 +14,8 @@ sub my_quote_parser {
   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;
+  die "surprising len=undef" if !defined($len);
+  die "surprising len=$len" if $len <= 0;
   $content =~ s/(.)/sprintf("\\x{%x}", ord($1))/seg;
   substr $linestr, $offset, $len, "(\"$content\")";
   Devel::Declare::set_linestr($linestr);

diff --git a/t/scanstr_fail.t b/t/scanstr_fail.t
new file mode 100644 (file)
index 0000000..2a64ad7
--- /dev/null
+++ b/t/scanstr_fail.t
@@ -0,0 +1,27 @@
+use warnings;
+use strict;
+
+use Devel::Declare ();
+use Test::More tests => 1;
+
+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);
+  die "suprising len=$len" if defined $len;
+  die "toke_scan_str fail\n";
+}
+
+BEGIN {
+  Devel::Declare->setup_for(__PACKAGE__, {
+    my_quote => { const => \&my_quote_parser },
+  });
+}
+
+eval q{ my_quote[foo };
+is $@, "toke_scan_str fail\n";
+
+1;