* lisp/progmodes/perl-mode.el: Refine handling of /re/ and y/abc/def/

(perl--syntax-exp-intro-keywords): New var.
(perl--syntax-exp-intro-regexp, perl-syntax-propertize-function): Use it.
(bug#20800).

2 files changed, 33 insertions, 11 deletions

diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index a64944f0dc5..3521a139809 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -204,10 +204,13 @@
   '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>)))
 
 (eval-and-compile
+  (defconst perl--syntax-exp-intro-keywords
+    '("split" "if" "unless" "until" "while" "print"
+      "grep" "map" "not" "or" "and" "for" "foreach"))
+
   (defconst perl--syntax-exp-intro-regexp
     (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
-            (regexp-opt '("split" "if" "unless" "until" "while" "print"
-                          "grep" "map" "not" "or" "and" "for" "foreach"))
+            (regexp-opt perl--syntax-exp-intro-keywords)
             "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
 
 ;; FIXME: handle here-docs and regexps.
@@ -278,8 +281,13 @@
                       (forward-comment (- (point-max)))
                       (put-text-property (point) (match-end 2)
                                          'syntax-multiline t)
-                      (not (memq (char-before)
-                                 '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
+                      (not (or (and (eq ?w (char-syntax (preceding-char)))
+                                    (let ((end (point)))
+                                      (backward-sexp 1)
+                                      (member (buffer-substring (point) end)
+                                              perl--syntax-exp-intro-keywords)))
+                               (memq (char-before)
+                                     '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))))
                nil ;; A division sign instead of a regexp-match.
              (put-text-property (match-beginning 2) (match-end 2)
                                 'syntax-table (string-to-syntax "\""))
@@ -297,13 +305,19 @@
                                (looking-at-p "sub[ \t\n]"))
                ;; This is defining a function.
                nil
-             (put-text-property (match-beginning 3) (match-end 3)
-                                'syntax-table
-                                (if (assoc (char-after (match-beginning 3))
-                                           perl-quote-like-pairs)
-                                    (string-to-syntax "|")
-                                  (string-to-syntax "\"")))
-             (perl-syntax-propertize-special-constructs end)))))
+             (unless (nth 8 (save-excursion (syntax-ppss (match-beginning 1))))
+               ;; Don't add this syntax-table property if
+               ;; within a string, which would misbehave in cases such as
+               ;; $a = "foo y \"toto\" bar" where we'd end up changing the
+               ;; syntax of the backslash and hence de-escaping the embedded
+               ;; double quote.
+               (put-text-property (match-beginning 3) (match-end 3)
+                                  'syntax-table
+                                  (if (assoc (char-after (match-beginning 3))
+                                             perl-quote-like-pairs)
+                                      (string-to-syntax "|")
+                                    (string-to-syntax "\"")))
+               (perl-syntax-propertize-special-constructs end))))))
       ;; Here documents.
       ((concat
         "\\(?:"
diff --git a/test/indent/perl.perl b/test/indent/perl.perl
index ea487543219..f86a09b2733 100755
--- a/test/indent/perl.perl
+++ b/test/indent/perl.perl
@@ -59,3 +59,11 @@ print "hello" for /./;
 
 $fileType_filesButNot           # bug#12373?
     = join( '|', map { quotemeta($_).'$' } @{$fileType->{filesButNot}} );
+
+# There can be a comment between an if/when/while and a /<re>/ matcher!
+return 'W' if               #/^Not Available on Mobile/m;    #W=Web only
+    /This video is not available on mobile devices./m;       #bug#20800
+
+# A "y|abc|def|" shouldn't interfere when inside a string!
+$toto = " x \" string\"";
+$toto = " y \" string\"";       # This is not the `y' operator!