cperl-mode.el: Correctly terminate HERE-docs

* lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): cperl-mode
in the master branch wrongly uses the first occurrence of "HERE"
to terminate the string, resulting in badly fontified / indented
code which follows (bug#42251).

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 6fe0c018b1d197c3667a448d8eed95d45a409c9a..5ecd5668b343aac4e12b1dc2c59e1e4683ec90d6 100644 (file)
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -3560,19 +3560,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
           "\\(\\`\n?\\|^\n\\)="        ; POD
           "\\|"
           ;; One extra () before this:
-          "<<~?"                       ; HERE-DOC
-          "\\("                        ; 1 + 1
+          "<<\\(~?\\)"          ; HERE-DOC, indented-p = capture 2
+          "\\("                        ; 2 + 1
           ;; First variant "BLAH" or just ``.
           "[ \t]*"                     ; Yes, whitespace is allowed!
-          "\\([\"'`]\\)"               ; 2 + 1 = 3
-          "\\([^\"'`\n]*\\)"           ; 3 + 1
-          "\\3"
+          "\\([\"'`]\\)"               ; 3 + 1 = 4
+          "\\([^\"'`\n]*\\)"           ; 4 + 1
+          "\\4"
           "\\|"
           ;; Second variant: Identifier or \ID (same as 'ID') or empty
-          "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1
+          "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 5 + 1, 6 + 1
           ;; Do not have <<= or << 30 or <<30 or << $blah.
           ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
-          "\\(\\)"             ; To preserve count of pars :-( 6 + 1
           "\\)"
           "\\|"
           ;; 1+6 extra () before this:
@@ -3762,11 +3761,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
               ;;    ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1
               ;;    "\\(\\)"           ; To preserve count of pars :-( 6 + 1
               ;;  "\\)"
-              ((match-beginning 2)     ; 1 + 1
+              ((match-beginning 3)     ; 2 + 1
                (setq b (point)
                      tb (match-beginning 0)
                      c (and            ; not HERE-DOC
-                        (match-beginning 5)
+                        (match-beginning 6)
                         (save-match-data
                           (or (looking-at "[ \t]*(") ; << function_call()
                               (save-excursion ; 1 << func_name, or $foo << 10
@@ -3793,17 +3792,17 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                                   (looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>")))
                                                (error t)))))))
                                   (error nil))) ; func(<<EOF)
-                              (and (not (match-beginning 6)) ; Empty
+                              (and (not (match-beginning 7)) ; Empty
                                    (looking-at
                                     "[ \t]*[=0-9$@%&(]"))))))
                (if c                   ; Not here-doc
                    nil                 ; Skip it.
-                 (setq c (match-end 2)) ; 1 + 1
-                 (if (match-beginning 5) ;4 + 1
-                     (setq b1 (match-beginning 5) ; 4 + 1
-                           e1 (match-end 5)) ; 4 + 1
-                   (setq b1 (match-beginning 4) ; 3 + 1
-                         e1 (match-end 4))) ; 3 + 1
+                 (setq c (match-end 3)) ; 2 + 1
+                 (if (match-beginning 6) ;6 + 1
+                     (setq b1 (match-beginning 6) ; 5 + 1
+                           e1 (match-end 6)) ; 5 + 1
+                   (setq b1 (match-beginning 5) ; 4 + 1
+                         e1 (match-end 5))) ; 4 + 1
                  (setq tag (buffer-substring b1 e1)
                        qtag (regexp-quote tag))
                  (cond (cperl-pod-here-fontify
@@ -3818,8 +3817,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                  (setq b (point))
                  ;; We do not search to max, since we may be called from
                  ;; some hook of fontification, and max is random
-                 (or (and (re-search-forward (concat "^[ \t]*" qtag "$")
-                                             stop-point 'toend)
+                 (or (and (re-search-forward
+                           (concat "^" (when (equal (match-string 2) "~") "[ \t]*")
+                                   qtag "$")
+                           stop-point 'toend)
                           ;;;(eq (following-char) ?\n) ; XXXX WHY???
                           )
                    (progn              ; Pretend we matched at the end