;cperl-mode.el: Fix fontification edge cases

These were reported by happy-barney on GitHub
https://github.com/HaraldJoerg/cperl-mode/issues

* lisp/progmodes/cperl-mode.el (cperl-init-faces): Don't mistake
$method as a method declaration.
Move matcher for "use require" higher to prevent "require" being
fontified as keyword.

* test/lisp/progmodes/cperl-mode-resources/sub-names.pl: Add a
test case for $method

* test/lisp/progmodes/cperl-mode-tests.el
(cperl-test-fontify-declarations): Add a test case for a module
name looking like a keyword
(cperl-test-fontify-sub-names): Verify that $method does not
declare a method

3 files changed, 45 insertions, 24 deletions

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index d3014fee2b7..91e2e46fdba 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -6353,7 +6353,7 @@ functions (which they are not).  Inherits from `default'.")
             ;; facespec is evaluated depending on whether the
             ;; statement ends in a "{" (definition) or ";"
             ;; (declaration without body)
-	    (list (concat "\\<" cperl-sub-regexp
+	    (list (concat "\\(?:\\`\\|[^$%@*&]\\)" cperl-sub-regexp
                           ;; group 1: optional subroutine name
                           (rx
                            (sequence (eval cperl--ws+-rx)
@@ -6400,7 +6400,24 @@ functions (which they are not).  Inherits from `default'.")
                         (error (match-end 2))))
                     nil
                     (1 font-lock-variable-name-face)))
-            ;; -------- flow control
+             ;; -------- various stuff calling for a package name
+            ;; (matcher (subexp facespec) (subexp facespec))
+            `(,(rx (sequence
+                    (or (sequence (or line-start space "{" )
+                                  (group-n 1 (or "package" "require" "use"
+                                                 "import" "no" "bootstrap" "class"))
+                                  (eval cperl--ws+-rx))
+                        (sequence (group-n 2 (sequence ":"
+                                                       (eval cperl--ws*-rx)
+                                                       "isa"))
+                                  "("
+                                  (eval cperl--ws*-rx)))
+                    (group-n 3 (eval cperl--normal-identifier-rx))
+                    (any " \t\n;)"))) ; require A if B;
+              (1 font-lock-keyword-face t t)
+              (2 font-lock-constant-face t t)
+	      (3 font-lock-function-name-face))
+           ;; -------- flow control
             ;; (matcher . subexp) font-lock-keyword-face by default
 	    ;; This highlights declarations and definitions differently.
 	    ;; We do not try to highlight in the case of attributes:
@@ -6507,22 +6524,6 @@ functions (which they are not).  Inherits from `default'.")
             ;; (matcher subexp facespec)
 	    '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
 	      font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
-            ;; -------- various stuff calling for a package name
-            ;; (matcher (subexp facespec) (subexp facespec))
-            `(,(rx (sequence
-                    (or (sequence (or line-start space "{" )
-                                  (or "package" "require" "use" "import"
-                                      "no" "bootstrap" "class")
-                                  (eval cperl--ws+-rx))
-                        (sequence (group-n 2 (sequence ":"
-                                                       (eval cperl--ws*-rx)
-                                                       "isa"))
-                                  "("
-                                  (eval cperl--ws*-rx)))
-                    (group-n 1 (eval cperl--normal-identifier-rx))
-                    (any " \t\n;)"))) ; require A if B;
-	      (1 font-lock-function-name-face)
-              (2 font-lock-constant-face t t))
             ;; -------- formats
             ;; (matcher subexp facespec)
 	    '("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$"
diff --git a/test/lisp/progmodes/cperl-mode-resources/sub-names.pl b/test/lisp/progmodes/cperl-mode-resources/sub-names.pl
index 46d05b4dbd2..229106865a3 100644
--- a/test/lisp/progmodes/cperl-mode-resources/sub-names.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/sub-names.pl
@@ -17,6 +17,15 @@ say C->new->m;
 # This comment has a method name in it, and we don't want "method"
 # to be fontified as a keyword, nor "name" fontified as a name.
 
+# Next is a variable named "$method" followed by a keyword.  This
+# keyword is not a subroutine name and should not be fontified
+# accordingly.  Reported by Branislav Zahradnik,
+# https://github.com/HaraldJoerg/cperl-mode/issues/24
+
+push @abstract, $method
+	unless defined &$method
+	;
+
 __END__
 
 =head1 Test using the keywords POD
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 117eb9fdf9a..ffb79c6e5a2 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -143,7 +143,8 @@ point in the distant past, and is still broken in perl-mode. "
   (with-temp-buffer
     (funcall cperl-test-mode)
     (insert "package Foo::Bar;\n")
-    (insert "use Fee::Fie::Foe::Foo\n;")
+    (insert "use Fee::Fie::Foe::Foo\n;\n")
+    (insert "use require::relative;\n")  ; module name has a keyword
     (insert "my $xyzzy = 'PLUGH';\n")
     (goto-char (point-min))
     (font-lock-ensure)
@@ -153,9 +154,15 @@ point in the distant past, and is still broken in perl-mode. "
     (search-forward "use") ; This was buggy in perl-mode
     (should (equal (get-text-property (match-beginning 0) 'face)
                    'font-lock-keyword-face))
-    (search-forward "my")
-    (should (equal (get-text-property (match-beginning 0) 'face)
-                   'font-lock-keyword-face))))
+    (re-search-forward (rx(sequence(group-n 1 "use")
+                                   (1+ blank)
+                                   (group-n 2 "require"))))
+    (should (equal (get-text-property (match-beginning 1) 'face)
+                   'font-lock-keyword-face))
+    (should (equal (get-text-property (match-beginning 2) 'face)
+                   (if (eq cperl-test-mode #'cperl-mode)
+                       'font-lock-function-name-face
+                     'font-lock-constant-face)))))
 
 (ert-deftest cperl-test-fontify-attrs-and-signatures ()
   "Test fontification of the various combinations of subroutine
@@ -330,13 +337,17 @@ comments and POD they should be fontified as POD."
       (should (equal (get-text-property (match-beginning 1) 'face)
                      (if (equal cperl-test-mode 'perl-mode) nil
                        'cperl-method-call)))
-      ;; POD
+      ;; comment
       (search-forward-regexp "\\(method\\) \\(name\\)")
       (should (equal (get-text-property (match-beginning 1) 'face)
                      'font-lock-comment-face))
       (should (equal (get-text-property (match-beginning 2) 'face)
                      'font-lock-comment-face))
-      ;; comment
+      ;; false positive: $method is not a method
+      (search-forward-regexp "\\($method\\)\\(?:\n\\|\\s-\\)+\\(unless\\)")
+      (should (equal (get-text-property (match-beginning 2) 'face)
+                     'font-lock-keyword-face))
+      ;; POD
       (search-forward-regexp "\\(method\\) \\(name\\)")
       (should (equal (get-text-property (match-beginning 1) 'face)
                      'font-lock-comment-face))