Blob Blame History Raw
diff -up generators-1.06/bin/perl.prov.orig generators-1.06/bin/perl.prov
--- generators-1.06/bin/perl.prov.orig	2016-06-24 12:46:20.436213565 +0200
+++ generators-1.06/bin/perl.prov	2016-06-24 12:49:11.354484313 +0200
@@ -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;
diff -up generators-1.06/bin/perl.req.orig generators-1.06/bin/perl.req
--- generators-1.06/bin/perl.req.orig	2016-06-24 12:46:34.260154583 +0200
+++ generators-1.06/bin/perl.req	2016-06-24 12:51:45.703825754 +0200
@@ -93,13 +93,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;
@@ -151,8 +152,8 @@ sub process_file {
     }
 
     my $modver_re = qr/[.0-9]+/;
-    my $begin_re = qr#qw\s*[(\/'"!|{]\s*|qq?\s*[(\/'"!|{]\s*|['"]#;
-    my $end_re   = qr#[)\/"'!|}]#;
+    my $begin_re = qr#qw\s*[(\/'"!|{\[]\s*|qq?\s*[(\/'"!|{\[]\s*|['"]#;
+    my $end_re   = qr#[)\/"'!|}\]]#;
 
     # Skip multiline print and assign statements
     if ( m/\$\S+\s*=\s*(")([^"\\]|(\\.))*$/ ||
diff -up generators-1.06/t/08_heredoc.t.orig generators-1.06/t/08_heredoc.t
--- generators-1.06/t/08_heredoc.t.orig	2016-06-24 13:00:05.409693671 +0200
+++ generators-1.06/t/08_heredoc.t	2016-06-24 13:01:11.742410289 +0200
@@ -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",
 );
diff -up generators-1.06/t/data/heredoc.orig generators-1.06/t/data/heredoc
--- generators-1.06/t/data/heredoc.orig	2016-06-24 12:59:52.745747704 +0200
+++ generators-1.06/t/data/heredoc	2016-06-24 13:00:49.219506749 +0200
@@ -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";