; cperl-mode.el: Detect prototypes in anonymous subroutines

My commit 3d49ad73e5a from 2021-09-143 had a flaw causing bad
fontification and indentation after anonymous subroutines with
a prototype.
* lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Correctly
process prototypes in anonymous subroutines
* test/lisp/progmodes/cperl-mode-tests.el
(cperl-test-fontify-attrs-and-signatures): new tests for various
combinations of attributes, prototypes, and signatures
* test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl: new
	test source

1 files changed, 49 insertions, 0 deletions

diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 0124dad6f17..b8a3bd97d8d 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -154,6 +154,55 @@ point in the distant past, and is still broken in perl-mode. "
     (should (equal (get-text-property (match-beginning 0) 'face)
                    'font-lock-keyword-face))))
 
+(ert-deftest cperl-test-fontify-attrs-and-signatures ()
+  "Test fontification of the various combinations of subroutine
+attributes, prototypes and signatures."
+  (skip-unless (eq cperl-test-mode #'cperl-mode))
+  (let ((file (ert-resource-file "proto-and-attrs.pl")))
+    (with-temp-buffer
+      (insert-file-contents file)
+      (goto-char (point-min))
+      (funcall cperl-test-mode)
+      (font-lock-ensure)
+
+      ;; Named subroutines
+      (while (search-forward-regexp "\\_<sub_[[:digit:]]+" nil t)
+        (should (equal (get-text-property (match-beginning 0) 'face)
+                       'font-lock-function-name-face))
+        (let ((start-of-sub (match-beginning 0))
+              (end-of-sub (save-excursion (search-forward "}") (point))))
+
+          ;; Prototypes are shown as strings
+          (when (search-forward-regexp " ([$%@*]*) " end-of-sub t)
+            (should (equal (get-text-property (1+ (match-beginning 0)) 'face)
+                           'font-lock-string-face)))
+          (goto-char start-of-sub)
+          (when (search-forward-regexp "\\(:[a-z]+\\)\\((.*?)\\)?" end-of-sub t)
+            (should (equal (get-text-property (match-beginning 1) 'face)
+                           'font-lock-constant-face))
+            (when (match-beginning 2)
+              (should (equal (get-text-property (match-beginning 2) 'face)
+                             'font-lock-string-face))))
+          (goto-char end-of-sub)))
+
+      ;; Anonymous subroutines
+      (while (search-forward-regexp "= sub" nil t)
+        (let ((start-of-sub (match-beginning 0))
+              (end-of-sub (save-excursion (search-forward "}") (point))))
+
+          ;; Prototypes are shown as strings
+          (when (search-forward-regexp " ([$%@*]*) " end-of-sub t)
+            (should (equal (get-text-property (1+ (match-beginning 0)) 'face)
+                           'font-lock-string-face)))
+          (goto-char start-of-sub)
+          (when (search-forward-regexp "\\(:[a-z]+\\)\\((.*?)\\)?" end-of-sub t)
+            (should (equal (get-text-property (match-beginning 1) 'face)
+                           'font-lock-constant-face))
+            (when (match-beginning 2)
+              (should (equal (get-text-property (match-beginning 2) 'face)
+                             'font-lock-string-face))))
+          (goto-char end-of-sub))))))
+
 (ert-deftest cperl-test-fontify-special-variables ()
   "Test fontification of variables like $^T or ${^ENCODING}.
 These can occur as \"local\" aliases."