From fb26dc130db99cda4227257c10b9b8c38079b83f Mon Sep 17 00:00:00 2001
From: =?utf8?q?Harald=20J=C3=B6rg?= <haj@posteo.de>
Date: Mon, 19 Oct 2020 10:57:57 +0200
Subject: [PATCH] cperl-mode: Delete a misleading comment, add tests for
 verification

* lisp/progmodes/cperl-mode.el: Delete a comment which explains a
bug which has been fixed a long time ago (bug#44073).
* test/lisp/progmodes/cperl-mode-tests.el
(cperl-mode-fontify-punct-vars): Add regression tests to verify
that fontification of punctuation variables doesn't start strings.
---
 lisp/progmodes/cperl-mode.el                  |  7 ------
 .../fontify-punctuation-vars.pl               | 20 +++++++++++++++++
 test/lisp/progmodes/cperl-mode-tests.el       | 22 +++++++++++++++++++
 3 files changed, 42 insertions(+), 7 deletions(-)
 create mode 100644 test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 5b6e50c8206..ebbea6bed92 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -71,13 +71,6 @@
 
 ;; (define-key global-map [M-S-down-mouse-3] 'imenu)
 
-;;;; Font lock bugs as of v4.32:
-
-;; The following kinds of Perl code erroneously start strings:
-;; \$`  \$'  \$"
-;; $opt::s  $opt_s  $opt{s}  (s => ...)  /\s+.../
-;; likewise with m, tr, y, q, qX instead of s
-
 ;;; Code:
 
 ;;; Compatibility with older versions (for publishing on ELPA)
diff --git a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl
new file mode 100644
index 00000000000..fa328438cb1
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl
@@ -0,0 +1,20 @@
+# The following Perl punctiation variables contain characters which
+# are classified as string delimiters in the syntax table.  The mode
+# should not be confused by these.
+# The corresponding tests check that two consecutive '#' characters
+# are seen as comments, not as strings.
+my $pre = $`;  ##  $PREMATCH,      use another ` # to balance out
+my $pos = $';  ##  $POSTMATCH,     use another ' # to balance out
+my $lsp = $";  ##  $LIST_SEPARATOR use another " # to balance out
+
+# In the second level, we use the reference constructor \ on these
+# variables.  The backslash is an escape character *only* in strings.
+my $ref = \$`; ## \$PREMATCH,      use another ` # to balance out
+my $rif = \$'; ## \$POSTMATCH,     use another ' # to balance out
+my $raf = \$"; ## \$LIST_SEPARATOR use another " # to balance out
+
+my $opt::s = 0;       ## s is no substitution here
+my $opt_s  = 0;       ## s is no substitution here
+my %opt = (s => 0);   ## s is no substitution here
+$opt{s} = 0;          ## s is no substitution here
+$opt_s =~ /\s+.../    ## s is no substitution here
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index e2af2b5b8de..e67678cf6bb 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -196,4 +196,26 @@ Perl Best Practices sets some indentation values different from
             (should (equal got expected)))))
       (cperl-set-style "CPerl"))))
 
+(ert-deftest cperl-mode-fontify-punct-vars ()
+  "Test fontification of Perl's punctiation variables.
+Perl has variable names containing unbalanced quotes for the list
+separator $\" and pre- and postmatch $` and $'.  A reference to
+these variables, for example \\$\", should not cause the dollar
+to be escaped, which would then start a string beginning with the
+quote character.  This used to be broken in cperl-mode at some
+point in the distant past, and is still broken in perl-mode. "
+  (skip-unless (eq cperl-test-mode #'cperl-mode))
+  (let ((file (ert-resource-file "fontify-punctuation-vars.pl")))
+    (with-temp-buffer
+      (insert-file-contents file)
+      (goto-char (point-min))
+      (funcall cperl-test-mode)
+      (while (search-forward "##" nil t)
+        ;; The third element of syntax-ppss is true if in a string,
+        ;; which would indicate bad interpretation of the quote.  The
+        ;; fourth element is true if in a comment, which should be the
+        ;; case.
+        (should (equal (nth 3 (syntax-ppss)) nil))
+        (should (equal (nth 4 (syntax-ppss)) t))))))
+
 ;;; cperl-mode-tests.el ends here
-- 
2.39.2