Version 1.09

Changes

@@ -1,5 +1,8 @@
 Revision history for perl-generators.
 
+1.09  Thu Jun 23 2016
+- Fix regression in parsing of heredoc
+
 1.08  Fri Mar 18 2016
 - Accept square brackets for list of dependencies
 - Fixed generator to produce provides from code like this
@@ -28,7 +31,7 @@ Revision history for perl-generators.
 - Add changes released in rpm 4.12.0
 
 1.03  Mon Feb  2 2015
-- Update parcing of here-doc and quoted section which should be skipped
+- Update parsing of here-doc and quoted section which should be skipped
 - Update tests suite
 
 1.02  Fri Dec 12 2014

Makefile.PL

@@ -5,7 +5,7 @@ use ExtUtils::MakeMaker;
 
 WriteMakefile(
     'NAME' => 'generators',
-    'VERSION' => '1.08',
+    'VERSION' => '1.09',
     'AUTHOR' => 'Jitka Plesnikova <[email protected]>',
     'LICENSE' => 'gpl',
     'EXE_FILES' => [ ( glob 'bin/*' ) ],

bin/perl.prov

@@ -74,13 +74,14 @@ sub process_file {
 
     # skip the here-docs "<<" blocks
     # assume that <<12 means bitwise operation
-    if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?([^"'#<@])<<(\w+)\s*/ &&
-          ($2 !~ m/^\d+$/)) ||
-         m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*(["'`])(.+?|)\1\s*/
+    if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<[\\]?(\w+)\s*/ &&
+          ($1 !~ m/^\d+$/)) ||
+         m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*('[^']*?'|"[^"]*?"|`[^`]*?`)\s*/
         ) &&
          ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/
        ) {
-      $tag = $2;
+      $tag = $1;
+      $tag =~ s/['"`]//g;
       while (<FILE>) {
         chomp;
         ( $_ eq $tag ) && last;

bin/perl.req

@@ -94,13 +94,14 @@ sub process_file {
 
     # skip the here-docs "<<" blocks
     # assume that <<12 means bitwise operation
-    if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?([^"'#<@])<<(\w+)\s*/ &&
-          ($2 !~ m/^\d+$/)) ||
-         m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*(["'`])(.+?|)\1\s*/
+    if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<[\\]?(\w+)\s*/ &&
+          ($1 !~ m/^\d+$/)) ||
+         m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*('[^']*?'|"[^"]*?"|`[^`]*?`)\s*/
         ) &&
          ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/
        ) {
-      $tag = $2;
+      $tag = $1;
+      $tag =~ s/['"`]//g;
       if ($_ =~ m/^\s*use\s(constant)\s/) { add_require($1, undef) }
       while (<FILE>) {
         chomp;

t/08_heredoc.t

@@ -22,6 +22,7 @@ my @expectedrequires = (
     "perl(Bitwise::Operator)\n",
     "perl(constant)\n",
     "perl(More::Then::Two::Mark)\n",
+    "perl(Not::Hang)\n",
     "perl(Not::In::Heredoc)\n",
     "perl(THAT)\n",
 );

t/data/heredoc

@@ -150,6 +150,26 @@ package Number::As::Tag;
 use Number::As::Tag;
 1234
 
+$cost = <<\VISTA;   # Same thing!
+ That'll be $10 please, ma'am.
+package Vista
+use Vista
+VISTA
+
+s/this/<<E . 'that'
+the other
+package Regex
+use Regex
+E
+. 'more '/eg;
+
+# Should not hang the test
+sub demo {
+  $foobarbaztest++ if  /\s*= <<'/x;
+  use Not::Hang
+}
+
+
 # This case should be the last and should be found each time.
 print "<<TEST";
 push @OUT, "return <<'END';\n";