diff options
Diffstat (limited to 'test/lisp')
| -rw-r--r-- | test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl | 50 | ||||
| -rw-r--r-- | test/lisp/progmodes/cperl-mode-tests.el | 49 |
2 files changed, 99 insertions, 0 deletions
diff --git a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl new file mode 100644 index 00000000000..7138bf631df --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl @@ -0,0 +1,50 @@ +# The next two lines are required as of 2022, but obsolescent +# as soon as signatures leave their "experimental" state +use feature 'signatures'; +no warnings 'experimental::signatures'; + +# Tests for subroutine prototypes, signatures and the like + +# Prototypes have syntactical properties different from "normal" Perl: +# Perl has a variable $), so ($)) is not an unbalanced parenthesis. +# On the other hand, in a prototype ($) is _not_ an open paren +# followed by the variable $), so the parens are balanced. Prototypes +# are somewhat frowned upon most of the times, but they are required +# for some Perl magic + +# FIXME: 2022-02-02 CPerl mode does not handle subroutine signatures. +# In simple cases it mistakes them as prototypes, when attributes are +# present, it doesn't handle them at all. Variables in signatures +# SHOULD be fontified like variable declarations. + +# Part 1: Named subroutines +# A prototype and a trivial subroutine attribute +{ + no feature 'signatures'; # that's a prototype, not a signature + sub sub_1 ($) :lvalue { local $); } +} + +# A prototype as an attribute (how it should be written these days) +sub sub_2 :prototype($) { ...; } + +# A signature (these will soon-ish leave the experimental state) +sub sub_3 ($foo,$bar) { ...; } + +# Attribute plus signature FIXME: Not yet supported +sub bad_sub_4 :prototype($$$) ($foo,$bar,$baz) { ...; } + +# Part 2: Same constructs for anonymous subs +# A prototype and a trivial subroutine attribute +{ + no feature 'signatures'; # that's a prototype, not a signature + my $subref_1 = sub ($) :lvalue { local $); }; +} + +# A prototype as an attribute (how it should be written these days) +my $subref_2 = sub :prototype($) { ...; }; + +# A signature (these will soon-ish leave the experimental state) +my $subref_3 = sub ($foo,$bar) { ...; }; + +# Attribute plus signature +my $subref_4 = sub :prototype($$$) ($foo,$bar,$baz) { ...; }; 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." |