From 5ba339c7f48f3a9e92087b590375102f9a8cc0b0 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Fri, 25 Apr 2014 15:22:26 -0400
Subject: [PATCH] * lisp/progmodes/perl-mode.el
 (perl--syntax-exp-intro-regexp): New var. (perl-syntax-propertize-function):
 Use it.  Extend handling of here-docs to the unquoted case.

---
 lisp/ChangeLog              | 10 +++++++--
 lisp/progmodes/perl-mode.el | 43 ++++++++++++++++---------------------
 test/indent/perl.perl       |  6 +++++-
 3 files changed, 32 insertions(+), 27 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4568c88c8d6..da8314cf617 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,13 @@
+2014-04-25  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* progmodes/perl-mode.el (perl--syntax-exp-intro-regexp): New var.
+	(perl-syntax-propertize-function): Use it.  Extend handling of
+	here-docs to the unquoted case.
+
 2014-04-25  Eli Zaretskii  <eliz@gnu.org>
 
-	* tooltip.el (tooltip-show-help-non-mode, tooltip-show-help): Use
-	equal-including-properties to compare help-echo strings.  (Bug#17331)
+	* tooltip.el (tooltip-show-help-non-mode, tooltip-show-help):
+	Use equal-including-properties to compare help-echo strings (bug#17331).
 
 2014-04-25  Leo Liu  <sdl.web@gmail.com>
 
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index ef372a34fdb..092aa2b2fac 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -66,22 +66,7 @@
 ;; a rich language; writing a more suitable parser would be a big job):
 ;; 2)  The globbing syntax <pattern> is not recognized, so special
 ;;       characters in the pattern string must be backslashed.
-;; 3)  The << quoting operators are not recognized; see below.
-;; 5)  To make '$' work correctly, $' is not recognized as a variable.
-;;     Use "$'" or $POSTMATCH instead.
 ;;
-;; If you don't use font-lock, additional problems will appear:
-;; 1)  Regular expression delimiters do not act as quotes, so special
-;;       characters such as `'"#:;[](){} may need to be backslashed
-;;       in regular expressions and in both parts of s/// and tr///.
-;; 4)  The q and qq quoting operators are not recognized; see below.
-;; 5)  To make variables such a $' and $#array work, perl-mode treats
-;;       $ just like backslash, so '$' is not treated correctly.
-;; 6)  Unfortunately, treating $ like \ makes ${var} be treated as an
-;;       unmatched }.  See below.
-;; 7)  When ' (quote) is used as a package name separator, perl-mode
-;;       doesn't understand, and thinks it is seeing a quoted string.
-
 ;; Here are some ugly tricks to bypass some of these problems:  the perl
 ;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
 ;; but will trick perl-mode into starting a quoted string, which
@@ -218,6 +203,13 @@
 (defvar perl-quote-like-pairs
   '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>)))
 
+(eval-and-compile
+  (defconst perl--syntax-exp-intro-regexp
+    (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
+            (regexp-opt '("split" "if" "unless" "until" "while" "print"
+                          "grep" "map" "not" "or" "and" "for" "foreach"))
+            "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
+
 ;; FIXME: handle here-docs and regexps.
 ;; <<EOF <<"EOF" <<'EOF' (no space)
 ;; see `man perlop'
@@ -278,10 +270,7 @@
       ;; *opening* slash.  We can afford to mis-match the closing ones
       ;; here, because they will be re-treated separately later in
       ;; perl-font-lock-special-syntactic-constructs.
-      ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
-               (regexp-opt '("split" "if" "unless" "until" "while" "split"
-                             "grep" "map" "not" "or" "and" "for" "foreach"))
-               "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
+      ((concat perl--syntax-exp-intro-regexp "\\(/\\)")
        (2 (ignore
            (if (and (match-end 1)       ; / at BOL.
                     (save-excursion
@@ -316,10 +305,15 @@
                                   (string-to-syntax "\"")))
              (perl-syntax-propertize-special-constructs end)))))
       ;; Here documents.
-      ;; TODO: Handle <<WORD.  These are trickier because you need to
-      ;; disambiguate with the shift operator.
-      ("<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\).*\\(\n\\)"
-       (2 (let* ((st (get-text-property (match-beginning 2) 'syntax-table))
+      ((concat
+        "\\(?:"
+        ;; << "EOF", << 'EOF', or << \EOF
+        "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
+        ;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to
+        ;; disambiguate with the left-bitshift operator.
+        "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)"
+        ".*\\(\n\\)")
+       (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table))
                  (name (match-string 1)))
             (goto-char (match-end 1))
             (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
@@ -329,7 +323,8 @@
                     ;; Remember the names of heredocs found on this line.
                     (cons (pcase (aref name 0)
                             (`?\\ (substring name 1))
-                            (_ (substring name 1 -1)))
+                            ((or `?\" `?\' `?\`) (substring name 1 -1))
+                            (_ name))
                           (cdr st)))))))
       ;; We don't call perl-syntax-propertize-special-constructs directly
       ;; from the << rule, because there might be other elements (between
diff --git a/test/indent/perl.perl b/test/indent/perl.perl
index c7a2fbfb2d2..0bfcc98356b 100755
--- a/test/indent/perl.perl
+++ b/test/indent/perl.perl
@@ -3,7 +3,11 @@
 
 if ($c && /====/){xyz;}
 
-print <<"EOF1" . s/he"llo/th'ere/;
+print "a" . <<EOF . s/he"llo/th'ere/;
+It's a surprise!
+EOF
+
+print <<\EOF1 . s/he"llo/th'ere/;
 foo
 EOF2
 bar
-- 
2.39.2