leave linestr prefix unchanged in toke_scan_str
Zefram [Sat, 5 Nov 2011 21:50:24 +0000 (21:50 +0000)]
Changes
Declare.xs
t/ctx-simple-like-mxms.t

diff --git a/Changes b/Changes
index b5270bc..1c21728 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Changes for Devel-Declare
 
+  - Adjust toke_scan_str logic to always leave the prefix part of
+    linestr unchanged.
+
 0.006007 - 12 Sep 2011
   - Depend on B::Hooks::OP::Check version 0.19, which fixes a serious bug in
     how it interacts with other modules that hook ops.
index 63ee08b..fc8e0e6 100644 (file)
@@ -227,7 +227,7 @@ int dd_toke_scan_str(pTHX_ int offset) {
       "Devel::Declare can't continue");
   if (!s)
     return 0;
-  if (s <= base_s) {
+  if (s <= base_s || memcmp(SvPVX(line_copy), SvPVX(PL_linestr), offset)) {
     s += SvCUR(line_copy);
     sv_catsv(line_copy, PL_linestr);
     dd_set_linestr(aTHX_ SvPV_nolen(line_copy));
index 0768078..348d124 100644 (file)
@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More tests => 5;
+use Test::More tests => 20;
 
 # This test script is derived from a MooseX::Method::Signatures test,
 # which is sensitive to some details of Devel::Declare behaviour that
@@ -31,6 +31,7 @@ sub mtfnpy_parser(@) {
     die "No name\n" unless defined $name;
     my $proto  = $ctx->strip_proto;
     die "Wrong declarator\n" unless $ctx->declarator eq "mtfnpy";
+    $proto =~ s/\n/\\n/g;
     $ctx->inject_if_block(qq[BEGIN { @{[__PACKAGE__]}::inject_after_scope(', q[${name}]);') } unshift \@_, "${proto}";], "(sub ");
     my $compile_stash = $ctx->get_curstash_name;
     $ctx->shadow(sub {
@@ -57,4 +58,38 @@ mtfnpy foo (extra) {
 
 foo(qw(a b c));
 
+mtfnpy bar (ex
+tra) {
+    is scalar(@_), 4;
+    is $_[0], "ex\ntra";
+    is $_[1], "a";
+    is $_[2], "b";
+    is $_[3], "c";
+}
+
+bar(qw(a b c));
+
+mtfnpy baz (ex
+tra extra extra) {
+    is scalar(@_), 4;
+    is $_[0], "ex\ntra extra extra";
+    is $_[1], "a";
+    is $_[2], "b";
+    is $_[3], "c";
+}
+
+baz(qw(a b c));
+
+mtfnpy quux (ex
+tra
+extra) {
+    is scalar(@_), 4;
+    is $_[0], "ex\ntra\nextra";
+    is $_[1], "a";
+    is $_[2], "b";
+    is $_[3], "c";
+}
+
+quux(qw(a b c));
+
 1;