From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Sat, 5 Dec 2020 15:41:03 +0000 (-0500)
Subject: * lisp/progmodes/perl-mode.el: Fix handling of s'foo'bar'
X-Git-Tag: emacs-28.0.90~4909
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fc54c835181eb88a748d2fd49b7a4c78b9fe82ee;p=emacs.git

* lisp/progmodes/perl-mode.el: Fix handling of s'foo'bar'

(perl-syntax-propertize-function): Don't put a syntax-property
on regexp-op delimiters if they're already handled correctly
by the normal syntax tables.
(perl-syntax-propertize-special-constructs): Mark the middle
quote of s'foo'bar' as punctuation.

* test/manual/indent/perl.perl: Add new test cases.
---

diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index bb19436cdad..fd8a51b5a54 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -299,12 +299,21 @@
                ;; $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 "\"")))
+               (let* ((b3 (match-beginning 3))
+                      (c (char-after b3)))
+                 (put-text-property
+                  b3 (match-end 3) 'syntax-table
+                  (cond
+                   ((assoc c perl-quote-like-pairs)
+                    (string-to-syntax "|"))
+                   ;; If the separator is a normal quote and the operation
+                   ;; only takes a single arg, then there's nothing
+                   ;; special to do.
+                   ((and (memq c '(?\" ?\'))
+                         (memq (char-after (match-beginning 2)) '(?m ?q)))
+                    nil)
+                   (t
+                    (string-to-syntax "\"")))))
                (perl-syntax-propertize-special-constructs end))))))
       ;; Here documents.
       ((concat
@@ -379,7 +388,8 @@
             (put-text-property (1- (point)) (point) 'syntax-table
                                (string-to-syntax "> c"))))))
      ((or (null (setq char (nth 3 state)))
-          (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
+          (and (characterp char)
+               (null (get-text-property (nth 8 state) 'syntax-table))))
       ;; Normal text, or comment, or docstring, or normal string.
       nil)
      ((eq (nth 3 state) ?\n)
@@ -400,6 +410,7 @@
                                                (point)))
                                '("tr" "s" "y"))))
             (close (cdr (assq char perl-quote-like-pairs)))
+            (middle nil)
             (st (perl-quote-syntax-table char)))
         (when (with-syntax-table st
 		(if close
@@ -430,6 +441,7 @@
 			   ;; In the case of s{...}{...}, we only handle the
 			   ;; first part here and the next below.
 			   (when (and twoargs (not close))
+			     (setq middle (point))
 			     (nth 8 (parse-partial-sexp
 				     (point) limit
 				     nil nil state 'syntax-table)))))))
@@ -437,11 +449,14 @@
 	  (when (eq (char-before (1- (point))) ?$)
 	    (put-text-property (- (point) 2) (1- (point))
 			       'syntax-table '(1)))
-	  (put-text-property (1- (point)) (point)
-			     'syntax-table
-			     (if close
-				 (string-to-syntax "|")
-			       (string-to-syntax "\"")))
+	  (if (and middle (memq char '(?\" ?\')))
+	      (put-text-property (1- middle) middle
+			     'syntax-table '(1))
+	    (put-text-property (1- (point)) (point)
+			       'syntax-table
+			       (if close
+				   (string-to-syntax "|")
+				 (string-to-syntax "\""))))
 	  ;; If we have two args with a non-self-paired starter (e.g.
 	  ;; s{...}{...}) we're right after the first arg, so we still have to
 	  ;; handle the second part.
diff --git a/test/manual/indent/perl.perl b/test/manual/indent/perl.perl
index 853aec49245..6ec04303b4f 100755
--- a/test/manual/indent/perl.perl
+++ b/test/manual/indent/perl.perl
@@ -81,3 +81,17 @@ return 'W' if               #/^Not Available on Mobile/m;    #W=Web only
 # A "y|abc|def|" shouldn't interfere when inside a string!
 $toto = " x \" string\"";
 $toto = " y \" string\"";       # This is not the `y' operator!
+
+
+# Tricky cases from Harald Jörg <haj@posteo.de>
+$_ = "abcabc\n";
+s:abc:def:g;  # FIXME: the initial s is fontified like a label, and indented
+
+s'def'ghi'g;  # The middle ' should not end the quoting.
+s"ghi"ijk"g;  # The middle ' should not end the quoting.
+
+s#ijk#lmn#g;  # This is a regular expression sustitution.
+
+s #lmn#opq#g; # FIXME: this should be a comment starting with "#lmn"
+  /lmn/rst/g; # and this is the actual regular expression
+print;        # prints "rstrst\n"