From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Sun, 19 Jan 2020 15:31:17 +0000 (-0800)
Subject: patched problem parsing here target in quote in pattern replacement string
X-Git-Tag: 20200619~139
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=83e3df50e0efeb77b36cfc0d7839030065bb4040;p=perltidy.git

patched problem parsing here target in quote in pattern replacement string
---

diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm
index 2c445b79..a82aa9d8 100644
--- a/lib/Perl/Tidy/Tokenizer.pm
+++ b/lib/Perl/Tidy/Tokenizer.pm
@@ -2776,8 +2776,13 @@ sub prepare_for_a_new_file {
                         }
 
                         # For an 'e' quote modifier we must scan the replacement
-                        # text for here-doc targets.
-                        if ($saw_modifier_e) {
+                        # text for here-doc targets...
+                        # but if the modifier starts a new line we can skip
+                        # this because either the here doc will be fully
+                        # contained in the replacement text (so we can
+                        # ignore it) or Perl will not find it.  
+                        # See test 'here2.in'.
+                        if ( $saw_modifier_e && $i_tok >= 0 ) {
 
                             my $rht = scan_replacement_text($qs1);
 
diff --git a/t/snippets/expect/here2.def b/t/snippets/expect/here2.def
new file mode 100644
index 00000000..a7ffe242
--- /dev/null
+++ b/t/snippets/expect/here2.def
@@ -0,0 +1,6 @@
+$_ = "";
+s|(?:)|"${\<<END}"
+ok $test - here2.in "" in multiline s///e outside eval
+END
+|e;
+print $_ || "not ok $test\n";
diff --git a/t/snippets/here2.in b/t/snippets/here2.in
new file mode 100644
index 00000000..a7ffe242
--- /dev/null
+++ b/t/snippets/here2.in
@@ -0,0 +1,6 @@
+$_ = "";
+s|(?:)|"${\<<END}"
+ok $test - here2.in "" in multiline s///e outside eval
+END
+|e;
+print $_ || "not ok $test\n";
diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index a9736c66..a959c9d4 100644
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -153,6 +153,7 @@
 ../snippets16.t	ndsm1.ndsm
 ../snippets16.t	rt131288.def
 ../snippets16.t	rt130394.rt130394
+../snippets16.t	git18.def
 ../snippets2.t	angle.def
 ../snippets2.t	arrows1.def
 ../snippets2.t	arrows2.def
@@ -313,4 +314,4 @@
 ../snippets9.t	rt98902.def
 ../snippets9.t	rt98902.rt98902
 ../snippets9.t	rt99961.def
-../snippets16.t	git18.def
+../snippets16.t	here2.def
diff --git a/t/snippets16.t b/t/snippets16.t
index a4cb2be2..20da519f 100644
--- a/t/snippets16.t
+++ b/t/snippets16.t
@@ -19,6 +19,7 @@
 #16 rt131288.def
 #17 rt130394.rt130394
 #18 git18.def
+#19 here2.def
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -110,6 +111,15 @@ my %bb = (
 foreach my $key ( keys %bb ) {
     print "key='$key' => $bb{$key}\n";
 }
+----------
+
+        'here2' => <<'----------',
+$_ = "";
+s|(?:)|"${\<<END}"
+ok $test - here2.in "" in multiline s///e outside eval
+END
+|e;
+print $_ || "not ok $test\n";
 ----------
 
         'multiple_equals' => <<'----------',
@@ -405,6 +415,19 @@ foreach my $key ( keys %bb ) {
 }
 #18...........
         },
+
+        'here2.def' => {
+            source => "here2",
+            params => "def",
+            expect => <<'#19...........',
+$_ = "";
+s|(?:)|"${\<<END}"
+ok $test - here2.in "" in multiline s///e outside eval
+END
+|e;
+print $_ || "not ok $test\n";
+#19...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};