From 70af9a9cb914ffc276eac58b10106f9449f2544c Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Fri, 4 Sep 2020 05:13:43 +0200 Subject: Fix infloop when indenting in cperl-mode * lisp/progmodes/cperl-mode.el (cperl-indent-exp): Fix (Bug#10483) Perl expressions (e.g. function calls) ending in ")" without statement terminator on the same line no longer loop endlessly. --- .../cperl-mode-resources/cperl-indent-exp.pl | 52 ++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl new file mode 100644 index 00000000000..4a9842ffa56 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl @@ -0,0 +1,52 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.020; + +# This file contains test input and expected output for the tests in +# cperl-mode-tests.el, cperl-mode-test-indent-exp. The code is +# syntactically valid, but doesn't make much sense. + +# -------- for loop: input -------- +for my $foo (@ARGV) +{ +...; +} +# -------- for loop: expected output -------- +for my $foo (@ARGV) { + ...; +} +# -------- for loop: end -------- + +# -------- while loop: input -------- +{ +while (1) +{ +say "boring loop"; +} +continue +{ +last; # no endless loop, though +} +} +# -------- while loop: expected output -------- +{ + while (1) { + say "boring loop"; + } continue { + last; # no endless loop, though + } +} +# -------- while loop: end -------- + +# -------- if-then-else: input -------- +if (my $foo) { bar() } elsif (quux()) { baz() } else { quuux } +# -------- if-then-else: expected output -------- +if (my $foo) { + bar(); +} elsif (quux()) { + baz(); +} else { + quuux; +} +# -------- if-then-else: end -------- -- cgit v1.2.3 From f7e68759d033e2a503f47cd7d97b760bd92e375f Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Thu, 17 Sep 2020 17:35:04 +0200 Subject: cperl-mode: Add new value "PBP" for 'cperl-set-style' * lisp/progmodes/cperl-mode.el (cperl-style-alist) (cperl-set-style): Add indentation style recommended by Damian Conway's book "Perl Best Practices". * test/lisp/progmodes/cperl-mode-tests.el (cperl-mode-test-indent-styles): Add a test to verify indentation and unraveling of conditionals (bug#43457). --- etc/NEWS | 8 ++++ lisp/progmodes/cperl-mode.el | 41 ++++++++++++++++---- .../cperl-mode-resources/cperl-indent-styles.pl | 44 ++++++++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 31 +++++++++++++++ 4 files changed, 116 insertions(+), 8 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/etc/NEWS b/etc/NEWS index 5b69e2f423b..3a7180cacf2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1179,6 +1179,14 @@ non-nil, even if protected by 'dbus-ignore-errors' otherwise. --- *** D-Bus events keep the type information of their arguments. +** CPerl Mode + +--- +*** The command 'cperl-set-style' offers the new value "PBP". +This value customizes Emacs to use the style recommended in Damian +Conway's book "Perl Best Practices" for indentation and formatting +of conditionals. + * New Modes and Packages in Emacs 28.1 diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index af179e2797e..8804e83fced 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1234,6 +1234,7 @@ versions of Emacs." ["Auto fill" auto-fill-mode t]) ("Indent styles..." ["CPerl" (cperl-set-style "CPerl") t] + ["PBP" (cperl-set-style "PBP") t] ["PerlStyle" (cperl-set-style "PerlStyle") t] ["GNU" (cperl-set-style "GNU") t] ["C++" (cperl-set-style "C++") t] @@ -1553,12 +1554,12 @@ Variables controlling indentation style: `cperl-min-label-indent' Minimal indentation for line that is a label. -Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith - `cperl-indent-level' 5 4 2 4 - `cperl-brace-offset' 0 0 0 0 - `cperl-continued-brace-offset' -5 -4 0 0 - `cperl-label-offset' -5 -4 -2 -4 - `cperl-continued-statement-offset' 5 4 2 4 +Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith + `cperl-indent-level' 5 4 2 4 4 + `cperl-brace-offset' 0 0 0 0 0 + `cperl-continued-brace-offset' -5 -4 0 0 0 + `cperl-label-offset' -5 -4 -2 -2 -4 + `cperl-continued-statement-offset' 5 4 2 4 4 CPerl knows several indentation styles, and may bulk set the corresponding variables. Use \\[cperl-set-style] to do this. Use @@ -6046,7 +6047,19 @@ if (foo) { stop; } -### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil +### PBP (=Perl Best Practices) 4/0/0/-4/4/nil/nil +if (foo) { + bar + baz; + label: + { + boon; + } +} +else { + stop; +} +### PerlStyle (=CPerl with 4 as indent) 4/0/0/-2/4/t/nil if (foo) { bar baz; @@ -6149,6 +6162,18 @@ else (cperl-extra-newline-before-brace-multiline . nil) (cperl-merge-trailing-else . t)) + ("PBP" ;; Perl Best Practices by Damian Conway + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -2) + (cperl-continued-statement-offset . 4) + (cperl-extra-newline-before-brace . nil) + (cperl-extra-newline-before-brace-multiline . nil) + (cperl-merge-trailing-else . nil) + (cperl-indent-parens-as-block . t) + (cperl-tab-always-indent . t)) + ("PerlStyle" ; CPerl with 4 as indent (cperl-indent-level . 4) (cperl-brace-offset . 0) @@ -6220,7 +6245,7 @@ See examples in `cperl-style-examples'.") "Set CPerl mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. The list of styles is in `cperl-style-alist', available styles -are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith. +are CPerl, PBP, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith. The current value of style is memorized (unless there is a memorized data already), may be restored by `cperl-set-style-back'. diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl new file mode 100644 index 00000000000..0832f868288 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl @@ -0,0 +1,44 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.020; + +# This file contains test input and expected output for the tests in +# cperl-mode-tests.el, cperl-mode-test-indent-exp. The code is +# syntactically valid, but doesn't make much sense. + +# -------- PBP indent: input -------- +for my $foo (@ARGV) +{ +...; +} +# -------- PBP indent: expected output -------- +for my $foo (@ARGV) { + ...; +} +# -------- PBP indent: end -------- + +# -------- PBP uncuddle else: input -------- +{ +if (1 < 2) +{ +say "Seems ok"; +} elsif (1 == 2) { +say "Strange things are happening"; +} else { +die "This world is backwards"; +} +} +# -------- PBP uncuddle else: expected output -------- +{ + if (1 < 2) { + say "Seems ok"; + } + elsif (1 == 2) { + say "Strange things are happening"; + } + else { + die "This world is backwards"; + } +} +# -------- PBP uncuddle else: end -------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 2eaf633d175..f0ff8e90052 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -172,4 +172,35 @@ end of the statement." (setq got (concat "test case " name ":\n" (buffer-string))) (should (equal got expected)))))))) +(ert-deftest cperl-mode-test-indent-styles () + "Verify correct indentation by style \"PBP\". +Perl Best Practices sets some indentation values different from + the defaults, and also wants an \"else\" or \"elsif\" keyword + to align with the \"if\"." + (let ((file (expand-file-name "cperl-indent-styles.pl" + cperl-mode-tests-data-directory))) + (with-temp-buffer + (cperl-set-style "PBP") + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward + (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n" + "\\(?2:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: expected output ?-+\n" + "\\(?3:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: end ?-+") + nil t) + (let ((name (match-string 1)) + (code (match-string 2)) + (expected (match-string 3)) + got) + (with-temp-buffer + (insert code) + (cperl-mode) + (indent-region (point-min) (point-max)) ; here we go! + (setq expected (concat "test case " name ":\n" expected)) + (setq got (concat "test case " name ":\n" (buffer-string))) + (should (equal got expected))))) + (cperl-set-style "CPerl")))) + ;;; cperl-mode-tests.el ends here -- cgit v1.2.3 From a14321ff69eac17ec0a8f3ee9cb106c1ed512281 Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Tue, 6 Oct 2020 03:39:55 +0200 Subject: cperl-mode: Fix a test to ensure cperl-mode is active * test/lisp/progmodes/cperl-mode-tests.el (cperl-mode-test-indent-exp): Make sure that cperl-mode is active for testing 'cperl-indent-exp', also skip this test under perl-mode. * test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl: Eliminate dependency on unrelated customizable variables (bug#10483). --- test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl | 4 ++-- test/lisp/progmodes/cperl-mode-tests.el | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl index 4a9842ffa56..8c1883a10f1 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl @@ -26,7 +26,7 @@ say "boring loop"; } continue { -last; # no endless loop, though +last; } } # -------- while loop: expected output -------- @@ -34,7 +34,7 @@ last; # no endless loop, though while (1) { say "boring loop"; } continue { - last; # no endless loop, though + last; } } # -------- while loop: end -------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index f0ff8e90052..20be7ed68cc 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -148,6 +148,7 @@ under timeout control." These exercise some standard blocks and also the special treatment for Perl expressions where a closing paren isn't the end of the statement." + (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((file (expand-file-name "cperl-indent-exp.pl" cperl-mode-tests-data-directory))) (with-temp-buffer @@ -166,6 +167,7 @@ end of the statement." got) (with-temp-buffer (insert code) + (cperl-mode) (goto-char (point-min)) (cperl-indent-exp) ; here we go! (setq expected (concat "test case " name ":\n" expected)) -- cgit v1.2.3 From fb26dc130db99cda4227257c10b9b8c38079b83f Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Mon, 19 Oct 2020 10:57:57 +0200 Subject: 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 (limited to 'test/lisp/progmodes/cperl-mode-resources') 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 -- cgit v1.2.3 From 84f74136d374421d3eb6a71a2e248e2b369cddbe Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Tue, 3 Nov 2020 15:28:40 +0100 Subject: cperl-mode: Fix indentation for Emacs 26 * lisp/progmodes/cperl-mode.el (cperl-mode): Add a fix which is only required for Emacs versions older than 27. * test/lisp/progmodes/cperl-mode-tests.el (cperl-bug30393): Add a test to verify correct indentation (bug#30393). --- lisp/progmodes/cperl-mode.el | 3 +++ .../cperl-mode-resources/cperl-bug-30393.pl | 19 ++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 29 ++++++++++++++++++++++ 3 files changed, 51 insertions(+) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-30393.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index ebbea6bed92..6178cdfc9ba 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1606,6 +1606,9 @@ or as help on variables `cperl-tips', `cperl-problems', (if (cperl-val 'cperl-electric-keywords) (abbrev-mode 1)) (set-syntax-table cperl-mode-syntax-table) + ;; Workaround for Bug#30393, needed for Emacs 26. + (when (< emacs-major-version 27) + (setq-local open-paren-in-column-0-is-defun-start nil)) ;; Until Emacs is multi-threaded, we do not actually need it local: (make-local-variable 'cperl-font-lock-multiline-start) (make-local-variable 'cperl-font-locking) diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-30393.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-30393.pl new file mode 100644 index 00000000000..01db7b5206c --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-30393.pl @@ -0,0 +1,19 @@ +# -------- bug#30393: input -------- +# + my $sql = "insert into jobs (id, priority) values (1, 2);"; + my $sth = $dbh->prepare($sql) or die "bother"; + + my $sql = "insert into jobs +(id, priority) +values (1, 2);"; + my $sth = $dbh->prepare($sql) or die "bother"; +# -------- bug#30393: expected output -------- +# +my $sql = "insert into jobs (id, priority) values (1, 2);"; +my $sth = $dbh->prepare($sql) or die "bother"; + +my $sql = "insert into jobs +(id, priority) +values (1, 2);"; +my $sth = $dbh->prepare($sql) or die "bother"; +# -------- bug#30393: end -------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index dcde3b68a03..2977f108131 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -220,6 +220,35 @@ point in the distant past, and is still broken in perl-mode. " (should (equal (nth 3 (syntax-ppss)) nil)) (should (equal (nth 4 (syntax-ppss)) t)))))) +(ert-deftest cperl-bug30393 () + "Verify that indentation is not disturbed by an open paren in col 0. +Perl is not Lisp: An open paren in column 0 does not start a function." + (let ((file (ert-resource-file "cperl-bug-30393.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward + (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n" + "\\(?2:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: expected output ?-+\n" + "\\(?3:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: end ?-+") + nil t) + (let ((name (match-string 1)) + (code (match-string 2)) + (expected (match-string 3)) + got) + (with-temp-buffer + (insert code) + (funcall cperl-test-mode) + (goto-char (point-min)) + (while (null (eobp)) + (cperl-indent-command) + (next-line)) + (setq expected (concat "test case " name ":\n" expected)) + (setq got (concat "test case " name ":\n" (buffer-string))) + (should (equal got expected)))))))) + (ert-deftest cperl-bug37127 () "Verify that closing a paren in a regex goes without a message. Also check that the message is issued if the regex terminator is -- cgit v1.2.3 From 8dc237270f88a6abce4df9a1235b38288792ab71 Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Mon, 9 Nov 2020 15:25:47 +0100 Subject: cperl-mode: Indentation of ')' follows customisation * lisp/progmodes/cperl-mode.el (cperl-style-alist): Add cperl-close-paren-offset to the settings for PBP style. * test/lisp/progmodes/cperl-mode-tests.el (cperl-bug19709): New test to verify correct indentation of closing parentheses (Bug#19709). * test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl: New test case with code from the bug report. * test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl: Add a new test clause for cperl-close-paren-offset. --- lisp/progmodes/cperl-mode.el | 1 + .../cperl-mode-resources/cperl-bug-19709.pl | 25 ++++++++++++++ .../cperl-mode-resources/cperl-indent-styles.pl | 10 ++++++ test/lisp/progmodes/cperl-mode-tests.el | 38 ++++++++++++++++++++++ 4 files changed, 74 insertions(+) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 6178cdfc9ba..d5b30025e7b 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5983,6 +5983,7 @@ else (cperl-continued-brace-offset . 0) (cperl-label-offset . -2) (cperl-continued-statement-offset . 4) + (cperl-close-paren-offset . -4) (cperl-extra-newline-before-brace . nil) (cperl-extra-newline-before-brace-multiline . nil) (cperl-merge-trailing-else . nil) diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl new file mode 100644 index 00000000000..f7c51a2ce57 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-19709.pl @@ -0,0 +1,25 @@ +# -------- bug#19709: input -------- +my $a = func1( + Module::test() + ); + +my $b = func2( + test() +); + +my $c = func3( + Module::test(), +); +# -------- bug#19709: expected output -------- +my $a = func1( + Module::test() +); + +my $b = func2( + test() +); + +my $c = func3( + Module::test(), +); +# -------- bug#19709: end -------- diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl index 0832f868288..371b19b7309 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl @@ -42,3 +42,13 @@ die "This world is backwards"; } } # -------- PBP uncuddle else: end -------- + +# -------- PBP closing paren offset: input -------- +my $a = func1( + Module::test() + ); +# -------- PBP closing paren offset: expected output -------- +my $a = func1( + Module::test() +); +# -------- PBP closing paren offset: end -------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index effebc8068c..bd8a1a9f16b 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -249,6 +249,44 @@ Perl is not Lisp: An open paren in column 0 does not start a function." (setq got (concat "test case " name ":\n" (buffer-string))) (should (equal got expected)))))))) +(ert-deftest cperl-bug19709 () + "Verify that indentation of closing paren works as intended. +Note that Perl mode has no setting for close paren offset, per +documentation it does the right thing anyway." + (let ((file (ert-resource-file "cperl-bug-19709.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward + (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n" + "\\(?2:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: expected output ?-+\n" + "\\(?3:\\(?:.*\n\\)+?\\)" + "# ?-+ \\1: end ?-+") + nil t) + (let ((name (match-string 1)) + (code (match-string 2)) + (expected (match-string 3)) + got) + (with-temp-buffer + (insert code) + (funcall cperl-test-mode) + (setq-local + ;; settings from the bug report + cperl-indent-level 4 + cperl-indent-parens-as-block t + cperl-close-paren-offset -4 + ;; same, adapted for per-mode + perl-indent-level 4 + perl-indent-parens-as-block t) + (goto-char (point-min)) + (while (null (eobp)) + (cperl-indent-command) + (next-line)) + (setq expected (concat "test case " name ":\n" expected)) + (setq got (concat "test case " name ":\n" (buffer-string))) + (should (equal got expected)))))))) + (ert-deftest cperl-bug37127 () "Verify that closing a paren in a regex goes without a message. Also check that the message is issued if the regex terminator is -- cgit v1.2.3 From f5f9e100972598b1bb9cea4c0445777db2e1131e Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Tue, 17 Nov 2020 00:20:26 +0100 Subject: perl-mode and cperl-mode: Recognize regex after "return" * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Add "return" to the keywords which start a regex. * lisp/progmodes/perl-mode.el (defconst): Add "return" to 'perl--syntax-exp-intro-keywords' (Bug#26850). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-28650): New test (bug#26850). --- lisp/progmodes/cperl-mode.el | 2 +- lisp/progmodes/perl-mode.el | 2 +- .../progmodes/cperl-mode-resources/cperl-bug-26850.pl | 16 ++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 15 +++++++++++++++ 4 files changed, 33 insertions(+), 2 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index a42ace105aa..0dc45515d41 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3959,7 +3959,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (not (memq (preceding-char) '(?$ ?@ ?& ?%))) (looking-at - "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\)\\>"))))) + "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>"))))) (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 7265aeee45d..bb19436cdad 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -209,7 +209,7 @@ (eval-and-compile (defconst perl--syntax-exp-intro-keywords '("split" "if" "unless" "until" "while" "print" - "grep" "map" "not" "or" "and" "for" "foreach")) + "grep" "map" "not" "or" "and" "for" "foreach" "return")) (defconst perl--syntax-exp-intro-regexp (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl new file mode 100644 index 00000000000..a02ea29fe9d --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-26850.pl @@ -0,0 +1,16 @@ +sub interesting { + $_ = shift; + return + />Today is .+\'s birthday\. likes? your comment: / + || /&birthdays=.*birthdays?\.<\/a>/; +} + +sub boring { + return + / likes? your post in Date: Tue, 5 Jan 2021 10:15:04 +0100 Subject: perl-mode: Display here-docs as strings instead of comments * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Handle HERE doc starter lines ending in a comment. (perl-heredoc): New face for HERE docs, inheriting from font-lock-string-face. (perl-font-lock-syntactic-face-function): Apply the new face to HERE docs (Bug#23461). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test--run-bug-10483): Skip for Perl mode. The test explicitly calls a function of CPerl mode. --- etc/NEWS | 3 + lisp/progmodes/perl-mode.el | 29 ++++- .../progmodes/cperl-mode-resources/here-docs.pl | 143 +++++++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 32 +++++ 4 files changed, 206 insertions(+), 1 deletion(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/here-docs.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/etc/NEWS b/etc/NEWS index d8f25ab362e..ef1c4b39a6f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1833,6 +1833,9 @@ also keep the type information of their arguments. Use the ** CPerl Mode +--- +*** New face 'perl-heredoc', used for heredoc elements. + --- *** The command 'cperl-set-style' offers the new value "PBP". This value customizes Emacs to use the style recommended in Damian diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index ec20b01a0f0..2a2a4978c62 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -324,13 +324,33 @@ ;; disambiguate with the left-bitshift operator. "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)" ".*\\(\n\\)") - (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table)) + (4 (let* ((eol (match-beginning 4)) + (st (get-text-property eol 'syntax-table)) (name (match-string 2)) (indented (match-beginning 1))) (goto-char (match-end 2)) (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) + ;; '<<' occurred in a string, or in a comment. ;; Leave the property of the newline unchanged. st + ;; Beware of `foo <<'BAR' #baz` because + ;; the newline needs to start the here-doc + ;; and can't be used to close the comment. + (let ((eol-state (save-excursion (syntax-ppss eol)))) + (when (nth 4 eol-state) + (if (/= (1- eol) (nth 8 eol-state)) + ;; make the last char of the comment closing it + (put-text-property (1- eol) eol + 'syntax-table (string-to-syntax ">")) + ;; In `foo <<'BAR' #` the # is the last character + ;; before eol and can't both open and close the + ;; comment. Workaround: disguise the "#" as + ;; whitespace and fontify it as a comment. + (put-text-property (1- eol) eol + 'syntax-table (string-to-syntax "-")) + (put-text-property (1- eol) eol + 'font-lock-face + 'font-lock-comment-face)))) (cons (car (string-to-syntax "< c")) ;; Remember the names of heredocs found on this line. (cons (cons (pcase (aref name 0) @@ -483,8 +503,15 @@ ;; as twoarg). (perl-syntax-propertize-special-constructs limit))))))))) +(defface perl-heredoc + '((t (:inherit font-lock-string-face))) + "The face for here-documents. Inherits from font-lock-string-face.") + (defun perl-font-lock-syntactic-face-function (state) (cond + ((and (eq 2 (nth 7 state)) ; c-style comment + (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) ; HERE doc + 'perl-heredoc) ((and (nth 3 state) (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) ;; This is a second-arg of s{..}{...} form; let's check if this second diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl new file mode 100644 index 00000000000..8af4625fff3 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl @@ -0,0 +1,143 @@ +use 5.020; + +=head1 NAME + +here-docs.pl - resource file for cperl-test-here-docs + +=head1 DESCRIPTION + +This file holds a couple of HERE documents, with a variety of normal +and edge cases. For a formatted view of this description, run: + + (cperl-perldoc "here-docs.pl") + +For each of the HERE documents, the following checks will done: + +=over 4 + +=item * + +All occurrences of the string "look-here" are fontified correcty. +Note that we deliberately test the face, not the syntax property: +Users won't care for the syntax property, but they see the face. +Different implementations with different syntax properties have been +seen in the past. + +=item * + +Indentation of the line(s) containing "look-here" is 0, i.e. there are no +leading spaces. + +=item * + +Indentation of the following perl statement containing "indent" should +be 0 if the statement contains "noindent", and according to the mode's +continued-statement-offset otherwise. + +=back + +=cut + +# Prologue to make the test file valid without warnings + +my $text; +my $any; +my $indentation; +my $anywhere = 'back again'; +my $noindent; + +=head1 The Tests + +=head2 Test Case 1 + +We have two HERE documents in one line with different quoting styles. + +=cut + +## test case + +$text = <<"HERE" . <<'THERE' . $any; +#look-here and +HERE +$tlook-here and +THERE + +$noindent = "This should be left-justified"; + +=head2 Test case 2 + +A HERE document followed by a continuation line + +=cut + +## test case + +$text = < Date: Wed, 17 Feb 2021 00:54:38 +0100 Subject: cperl-mode: Improve detection of index entries for imenu * lisp/progmodes/cperl-mode.el (cperl-imenu-addback): Customization variable deleted. This variable has been declared obsolete in 1998. (cperl--basic-identifier-regexp) and many other variables: defining regular expressions for basic Perl constructs. (cperl-imenu--create-perl-index): This function has been completely rewritten, keeping only some parts of the output formatting. It now recognizes a lot more package and subroutine declarations which came since Perl 5.14: Packages with a version and/or a block attached, lexical subroutines, declarations with a newline between the keyword "package" and the package name, and several more. This version also correctly separates subroutine names from attributes, does no longer support "unnamed" packages (which don't exist in Perl), and doesn't fall for false positives like stuff that looks like a declaration in a multiline string. (cperl-tags-hier-init): Eliminate call to `cperl-imenu-addback` (which actually was commented out in 1997) * test/lisp/progmodes/cperl-mode-tests.el (cperl-test--validate-regexp) and six other new tests for the new regular expressions and the index creation. * test/lisp/progmodes/cperl-mode-resources/grammar.pl: New file showcasing different syntax variations for package and sub declarations (bug#46574). --- lisp/progmodes/cperl-mode.el | 360 +++++++++++++-------- .../lisp/progmodes/cperl-mode-resources/grammar.pl | 158 +++++++++ test/lisp/progmodes/cperl-mode-tests.el | 95 ++++++ 3 files changed, 484 insertions(+), 129 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/grammar.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 0dffe279c39..44a75269524 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -440,12 +440,6 @@ after reload." :type 'boolean :group 'cperl-speed) -(defcustom cperl-imenu-addback nil - "Not-nil means add backreferences to generated `imenu's. -May require patched `imenu' and `imenu-go'. Obsolete." - :type 'boolean - :group 'cperl-help-system) - (defcustom cperl-max-help-size 66 "Non-nil means shrink-wrapping of info-buffer allowed up to these percents." :type '(choice integer (const nil)) @@ -1216,6 +1210,153 @@ versions of Emacs." The expansion is entirely correct because it uses the C preprocessor." t) + +;;; Perl Grammar Components +;; +;; The following regular expressions are building blocks for a +;; minimalistic Perl grammar, to be used instead of individual (and +;; not always consistent) literal regular expressions. + +(defconst cperl--basic-identifier-regexp + (rx (sequence (or alpha "_") (* (or word "_")))) + "A regular expression for the name of a \"basic\" Perl variable. +Neither namespace separators nor sigils are included. As is, +this regular expression applies to labels,subroutine calls where +the ampersand sigil is not required, and names of subroutine +attributes.") + +(defconst cperl--label-regexp + (rx-to-string + `(sequence + symbol-start + (regexp ,cperl--basic-identifier-regexp) + (0+ space) + ":")) + "A regular expression for a Perl label. +By convention, labels are uppercase alphabetics, but this isn't +enforced.") + +(defconst cperl--normal-identifier-regexp + (rx-to-string + `(or + (sequence + (1+ (sequence + (opt (regexp ,cperl--basic-identifier-regexp)) + "::")) + (opt (regexp ,cperl--basic-identifier-regexp))) + (regexp ,cperl--basic-identifier-regexp))) + "A regular expression for a Perl variable name with optional namespace. +Examples are `foo`, `Some::Module::VERSION`, and `::` (yes, that +is a legal variable name).") + +(defconst cperl--special-identifier-regexp + (rx-to-string + `(or + (1+ digit) ; $0, $1, $2, ... + (sequence "^" (any "A-Z" "]^_?\\")) ; $^V + (sequence "{" (0+ space) ; ${^MATCH} + "^" (any "A-Z" "]^_?\\") + (0+ (any "A-Z" "_" digit)) + (0+ space) "}") + (in "!\"$%&'()+,-./:;<=>?@\\]^_`|~"))) ; $., $|, $", ... but not $^ or ${ + "The list of Perl \"punctuation\" variables, as listed in perlvar.") + +(defconst cperl--ws-regexp + (rx-to-string + '(or space "\n")) + "Regular expression for a single whitespace in Perl.") + +(defconst cperl--eol-comment-regexp + (rx-to-string + '(sequence "#" (0+ (not (in "\n"))) "\n")) + "Regular expression for a single end-of-line comment in Perl") + +(defconst cperl--ws-or-comment-regexp + (rx-to-string + `(1+ + (or + (regexp ,cperl--ws-regexp) + (regexp ,cperl--eol-comment-regexp)))) + "Regular expression for a sequence of whitespace and comments in Perl.") + +(defconst cperl--ows-regexp + (rx-to-string + `(opt (regexp ,cperl--ws-or-comment-regexp))) + "Regular expression for optional whitespaces or comments in Perl") + +(defconst cperl--version-regexp + (rx-to-string + `(or + (sequence (opt "v") + (>= 2 (sequence (1+ digit) ".")) + (1+ digit) + (opt (sequence "_" (1+ word)))) + (sequence (1+ digit) + (opt (sequence "." (1+ digit))) + (opt (sequence "_" (1+ word)))))) + "A sequence for recommended version number schemes in Perl.") + +(defconst cperl--package-regexp + (rx-to-string + `(sequence + "package" ; FIXME: the "class" and "role" keywords need to be + ; recognized soon...ish. + (regexp ,cperl--ws-or-comment-regexp) + (group (regexp ,cperl--normal-identifier-regexp)) + (opt + (sequence + (1+ (regexp ,cperl--ws-or-comment-regexp)) + (group (regexp ,cperl--version-regexp)))))) + "A regular expression for package NAME VERSION in Perl. +Contains two groups for the package name and version.") + +(defconst cperl--package-for-imenu-regexp + (rx-to-string + `(sequence + (regexp ,cperl--package-regexp) + (regexp ,cperl--ows-regexp) + (group (or ";" "{")))) + "A regular expression to collect package names for `imenu`. +Catches \"package NAME;\", \"package NAME VERSION;\", \"package +NAME BLOCK\" and \"package NAME VERSION BLOCK.\" Contains three +groups: Two from `cperl--package-regexp` for the package name and +version, and a third to detect \"package BLOCK\" syntax.") + +(defconst cperl--sub-name-regexp + (rx-to-string + `(sequence + (optional (sequence (group (or "my" "state" "our")) + (regexp ,cperl--ws-or-comment-regexp))) + "sub" ; FIXME: the "method" and maybe "fun" keywords need to be + ; recognized soon...ish. + (regexp ,cperl--ws-or-comment-regexp) + (group (regexp ,cperl--normal-identifier-regexp)))) + "A regular expression to detect a subroutine start. +Contains two groups: One for to distinguish lexical from +\"normal\" subroutines and one for the subroutine name.") + +(defconst cperl--pod-heading-regexp + (rx-to-string + `(sequence + line-start "=head" + (group (in "1-4")) + (1+ (in " \t")) + (group (1+ (not (in "\n")))) + line-end)) ; that line-end seems to be redundant? + "A regular expression to detect a POD heading. +Contains two groups: One for the heading level, and one for the +heading text.") + +(defconst cperl--imenu-entries-regexp + (rx-to-string + `(or + (regexp ,cperl--package-for-imenu-regexp) ; 1..3 + (regexp ,cperl--sub-name-regexp) ; 4..5 + (regexp ,cperl--pod-heading-regexp))) ; 6..7 + "A regular expression to collect stuff that goes into the `imenu` index. +Covers packages, subroutines, and POD headings.") + + ;; These two must be unwound, otherwise take exponential time (defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*" "Regular expression to match optional whitespace with interspersed comments. @@ -1227,8 +1368,7 @@ Should contain exactly one group.") Should contain exactly one group.") -;; Is incorporated in `cperl-imenu--function-name-regexp-perl' -;; `cperl-outline-regexp', `defun-prompt-regexp'. +;; Is incorporated in `cperl-outline-regexp', `defun-prompt-regexp'. ;; Details of groups in this may be used in several functions; see comments ;; near mentioned above variable(s)... ;; sub($$):lvalue{} sub:lvalue{} Both allowed... @@ -5147,117 +5287,80 @@ indentation and initial hashes. Behaves usually outside of comment." ;; Previous space could have gone: (or (memq (preceding-char) '(?\s ?\t)) (insert " ")))))) -(defun cperl-imenu-addback (lst &optional isback name) - ;; We suppose that the lst is a DAG, unless the first element only - ;; loops back, and ISBACK is set. Thus this function cannot be - ;; applied twice without ISBACK set. - (cond ((not cperl-imenu-addback) lst) - (t - (or name - (setq name "+++BACK+++")) - (mapc (lambda (elt) - (if (and (listp elt) (listp (cdr elt))) - (progn - ;; In the other order it goes up - ;; one level only ;-( - (setcdr elt (cons (cons name lst) - (cdr elt))) - (cperl-imenu-addback (cdr elt) t name)))) - (if isback (cdr lst) lst)) - lst))) - -(defun cperl-imenu--create-perl-index (&optional regexp) - (require 'imenu) ; May be called from TAGS creator - (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) +(defun cperl-imenu--create-perl-index () + "Implement `imenu-create-index-function` for CPerl mode. +This function relies on syntaxification to exclude lines which +look like declarations but actually are part of a string, a +comment, or POD." + (interactive) ; We'll remove that at some point + (goto-char (point-min)) + (cperl-update-syntaxification (point-max)) + (let ((case-fold-search nil) + (index-alist '()) + (index-package-alist '()) + (index-pod-alist '()) + (index-sub-alist '()) (index-unsorted-alist '()) - (index-meth-alist '()) meth - packages ends-ranges p marker is-proto - is-pack index index1 name (end-range 0) package) - (goto-char (point-min)) - (cperl-update-syntaxification (point-max)) - ;; Search for the function - (progn ;;save-match-data - (while (re-search-forward - (or regexp cperl-imenu--function-name-regexp-perl) - nil t) - ;; 2=package-group, 5=package-name 8=sub-name + (package-stack '()) ; for package NAME BLOCK + (current-package "(main)") + (current-package-end (point-max))) ; end of package scope + ;; collect index entries + (while (re-search-forward cperl--imenu-entries-regexp nil t) + ;; First, check whether we have left the scope of previously + ;; recorded packages, and if so, eliminate them from the stack. + (while (< current-package-end (point)) + (setq current-package (pop package-stack)) + (setq current-package-end (pop package-stack))) + (let ((state (syntax-ppss)) + name marker) ; for the "current" entry (cond - ((and ; Skip some noise if building tags - (match-beginning 5) ; package name - ;;(eq (char-after (match-beginning 2)) ?p) ; package - (not (save-match-data - (looking-at "[ \t\n]*;")))) ; Plain text word 'package' - nil) - ((and - (or (match-beginning 2) - (match-beginning 8)) ; package or sub - ;; Skip if quoted (will not skip multi-line ''-strings :-(): - (null (get-text-property (match-beginning 1) 'syntax-table)) - (null (get-text-property (match-beginning 1) 'syntax-type)) - (null (get-text-property (match-beginning 1) 'in-pod))) - (setq is-pack (match-beginning 2)) - ;; (if (looking-at "([^()]*)[ \t\n\f]*") - ;; (goto-char (match-end 0))) ; Messes what follows - (setq meth nil - p (point)) - (while (and ends-ranges (>= p (car ends-ranges))) - ;; delete obsolete entries - (setq ends-ranges (cdr ends-ranges) packages (cdr packages))) - (setq package (or (car packages) "") - end-range (or (car ends-ranges) 0)) - (if is-pack ; doing "package" - (progn - (if (match-beginning 5) ; named package - (setq name (buffer-substring (match-beginning 5) - (match-end 5)) - name (progn - (set-text-properties 0 (length name) nil name) - name) - package (concat name "::") - name (concat "package " name)) - ;; Support nameless packages - (setq name "package;" package "")) - (setq end-range - (save-excursion - (parse-partial-sexp (point) (point-max) -1) (point)) - ends-ranges (cons end-range ends-ranges) - packages (cons package packages))) - (setq is-proto - (or (eq (following-char) ?\;) - (eq 0 (get-text-property (point) 'attrib-group))))) - ;; Skip this function name if it is a prototype declaration. - (if (and is-proto (not is-pack)) nil - (or is-pack - (setq name - (buffer-substring (match-beginning 8) (match-end 8))) - (set-text-properties 0 (length name) nil name)) - (setq marker (make-marker)) - (set-marker marker (match-end (if is-pack 2 8))) - (cond (is-pack nil) - ((string-match "[:']" name) - (setq meth t)) - ((> p end-range) nil) - (t - (setq name (concat package name) meth t))) - (setq index (cons name marker)) - (if is-pack - (push index index-pack-alist) - (push index index-alist)) - (if meth (push index index-meth-alist)) - (push index index-unsorted-alist))) - ((match-beginning 16) ; POD section - (setq name (buffer-substring (match-beginning 17) (match-end 17)) - marker (make-marker)) - (set-marker marker (match-beginning 17)) - (set-text-properties 0 (length name) nil name) - (setq name (concat (make-string - (* 3 (- (char-after (match-beginning 16)) ?1)) - ?\ ) - name) - index (cons name marker)) - (setq index1 (cons (concat "=" name) (cdr index))) - (push index index-pod-alist) - (push index1 index-unsorted-alist))))) + ((nth 3 state) nil) ; matched in a string, so skip + ((match-string 1) ; found a package name! + (unless (nth 4 state) ; skip if in a comment + (setq name (match-string-no-properties 1) + marker (copy-marker (match-end 1))) + (if (string= (match-string 3) ";") + (setq current-package name) ; package NAME; + ;; No semicolon, therefore we have: package NAME BLOCK. + ;; Stash the current package, because we need to restore + ;; it after the end of BLOCK. + (push current-package-end package-stack) + (push current-package package-stack) + ;; record the current name and its scope + (setq current-package name) + (setq current-package-end (save-excursion + (goto-char (match-beginning 3)) + (forward-sexp) + (point))) + (push (cons name marker) index-package-alist) + (push (cons (concat "package " name) marker) index-unsorted-alist)))) + ((match-string 5) ; found a sub name! + (unless (nth 4 state) ; skip if in a comment + (setq name (match-string-no-properties 5) + marker (copy-marker (match-end 5))) + ;; Qualify the sub name with the package if it doesn't + ;; already have one, and if it isn't lexically scoped. + ;; "my" and "state" subs are lexically scoped, but "our" + ;; are just lexical aliases to package subs. + (if (and (null (string-match "::" name)) + (or (null (match-string 4)) + (string-equal (match-string 4) "our"))) + (setq name (concat current-package "::" name))) + (let ((index (cons name marker))) + (push index index-alist) + (push index index-sub-alist) + (push index index-unsorted-alist)))) + ((match-string 6) ; found a POD heading! + (when (get-text-property (match-beginning 6) 'in-pod) + (setq name (concat (make-string + (* 3 (- (char-after (match-beginning 6)) ?1)) + ?\ ) + (match-string-no-properties 7)) + marker (copy-marker (match-beginning 7))) + (push (cons name marker) index-pod-alist) + (push (cons (concat "=" name) marker) index-unsorted-alist))) + (t (error "Unidentified match: %s" (match-string 0)))))) + ;; Now format the collected stuff (setq index-alist (if (default-value 'imenu-sort-function) (sort index-alist (default-value 'imenu-sort-function)) @@ -5266,14 +5369,14 @@ indentation and initial hashes. Behaves usually outside of comment." (push (cons "+POD headers+..." (nreverse index-pod-alist)) index-alist)) - (and (or index-pack-alist index-meth-alist) - (let ((lst index-pack-alist) hier-list pack elt group name) - ;; Remove "package ", reverse and uniquify. + (and (or index-package-alist index-sub-alist) + (let ((lst index-package-alist) hier-list pack elt group name) + ;; reverse and uniquify. (while lst - (setq elt (car lst) lst (cdr lst) name (substring (car elt) 8)) + (setq elt (car lst) lst (cdr lst) name (car elt)) (if (assoc name hier-list) nil (setq hier-list (cons (cons name (cdr elt)) hier-list)))) - (setq lst index-meth-alist) + (setq lst index-sub-alist) (while lst (setq elt (car lst) lst (cdr lst)) (cond ((string-match "\\(::\\|'\\)[_a-zA-Z0-9]+$" (car elt)) @@ -5301,17 +5404,18 @@ indentation and initial hashes. Behaves usually outside of comment." (push (cons "+Hierarchy+..." hier-list) index-alist))) - (and index-pack-alist + (and index-package-alist (push (cons "+Packages+..." - (nreverse index-pack-alist)) + (nreverse index-package-alist)) index-alist)) - (and (or index-pack-alist index-pod-alist + (and (or index-package-alist index-pod-alist (default-value 'imenu-sort-function)) index-unsorted-alist (push (cons "+Unsorted List+..." (nreverse index-unsorted-alist)) index-alist)) - (cperl-imenu-addback index-alist))) + ;; Finally, return the whole collection + index-alist)) ;; Suggested by Mark A. Hershberger @@ -6631,9 +6735,7 @@ One may build such TAGS files from CPerl mode menu." (cperl-tags-treeify to 1) (setcar (nthcdr 2 cperl-hierarchy) (cperl-menu-to-keymap (cons '("+++UPDATE+++" . -999) (cdr to)))) - (message "Updating list of classes: done, requesting display...") - ;;(cperl-imenu-addback (nth 2 cperl-hierarchy)) - )) + (message "Updating list of classes: done, requesting display..."))) (or (nth 2 cperl-hierarchy) (error "No items found")) (setq update diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl new file mode 100644 index 00000000000..c05fd7efc2a --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl @@ -0,0 +1,158 @@ +use 5.024; +use strict; +use warnings; + +sub outside { + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}'"; +} + +package Package; + +=head1 NAME + +grammar - A Test resource for regular expressions + +=head1 SYNOPSIS + +A Perl file showing a variety of declarations + +=head1 DESCRIPTION + +This file offers several syntactical constructs for packages, +subroutines, and POD to test the imenu capabilities of CPerl mode. + +Perl offers syntactical variations for package and subroutine +declarations. Packages may, or may not, have a version and may, or +may not, have a block of code attached to them. Subroutines can have +old-style prototypes, attributes, and signatures which are still +experimental but widely accepted. + +Various Extensions and future Perl versions will probably add new +keywords for "class" and "method", both with syntactical extras of +their own. + +This test file tries to keep up with them. + +=head2 Details + +The code is supposed to identify and exclude false positives, +e.g. declarations in a string or in POD, as well as POD in a string. +These should not go into the imenu index. + +=cut + +our $VERSION = 3.1415; +say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + +sub in_package { + # Special test for POD: A line which looks like POD, but actually + # is part of a multiline string. In the case shown here, the + # semicolon is not part of the string, but POD headings go to the + # end of the line. The code needs to distinguish between a POD + # heading "This Is Not A Pod/;" and a multiline string. + my $not_a_pod = q/Another false positive: + +=head1 This Is Not A Pod/; + +} + +sub Shoved::elsewhere { + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', sub Shoved::elsewhere"; +} + +sub prototyped ($$) { + ...; +} + +package Versioned::Package 0.07; +say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + +sub versioned { + # This sub is in package Versioned::Package + say "sub 'versioned' in package '", __PACKAGE__, "'"; +} + +versioned(); + +my $false_positives = <<'EOH'; +The following declarations are not supposed to be recorded for imenu. +They are in a HERE-doc, which is a generic comment in CPerl mode. + +package Don::T::Report::This; +sub this_is_no_sub { + my $self = shuffle; +} + +And this is not a POD heading: + +=head1 Not a POD heading, just a string. + +EOH + +package Block { + our $VERSION = 2.7182; + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + + sub attr:lvalue { + say "sub 'attr' in package '", __PACKAGE__, "'"; + } + + attr(); + + package Block::Inner { + # This hopefully doesn't happen too often. + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + } + + # Now check that we're back to package "Block" + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; +} + +sub outer { + # This is in package Versioned::Package + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; +} + +outer(); + +package Versioned::Block 42 { + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + + my sub lexical { + say "sub 'lexical' in package '", __PACKAGE__, "'"; + } + + lexical(); + + use experimental 'signatures'; + sub signatured :prototype($@) ($self,@rest) + { + ...; + } +} + +# After all is said and done, we're back in package Versioned::Package. +say "We're in package '", __PACKAGE__, "' now."; +say "Now try to call a subroutine which went out of scope:"; +eval { lexical() }; +say $@ if $@; + +# Now back to Package. This must not appear separately in the +# hierarchy list. +package Package; + +our sub in_package_again { + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; +} + + +package :: { + # This is just a weird, but legal, package name. + say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION"; + + in_package_again(); # weird, but calls the sub from above +} + +Shoved::elsewhere(); + +1; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 943c454445c..61e4ece49b7 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -166,6 +166,101 @@ point in the distant past, and is still broken in perl-mode. " (if (match-beginning 3) 0 perl-indent-level))))))) +;;; Grammar based tests: unit tests + +(defun cperl-test--validate-regexp (regexp valid &optional invalid) + "Runs tests for elements of VALID and INVALID lists against REGEXP. +Tests with elements from VALID must match, tests with elements +from INVALID must not match. The match string must be equal to +the whole string." + (funcall cperl-test-mode) + (dolist (string valid) + (should (string-match regexp string)) + (should (string= (match-string 0 string) string))) + (when invalid + (dolist (string invalid) + (should-not + (and (string-match regexp string) + (string= (match-string 0 string) string)))))) + +(ert-deftest cperl-test-ws-regexp () + "Tests capture of very simple regular expressions (yawn)." + (let ((valid + '(" " "\t" "\n")) + (invalid + '("a" " " ""))) + (cperl-test--validate-regexp cperl--ws-regexp + valid invalid))) + +(ert-deftest cperl-test-ws-or-comment-regexp () + "Tests sequences of whitespace and comment lines." + (let ((valid + `(" " "\t#\n" "\n# \n" + ,(concat "# comment\n" "# comment\n" "\n" "#comment\n"))) + (invalid + '("=head1 NAME\n" ))) + (cperl-test--validate-regexp cperl--ws-or-comment-regexp + valid invalid))) + +(ert-deftest cperl-test-version-regexp () + "Tests the regexp for recommended syntax of versions in Perl." + (let ((valid + '("1" "1.1" "1.1_1" "5.032001" + "v120.100.103")) + (invalid + '("alpha" "0." ".123" "1E2" + "v1.1" ; a "v" version string needs at least 3 components + ;; bad examples from "Version numbers should be boring" + ;; by xdg AKA David A. Golden + "1.20alpha" "2.34beta2" "2.00R3"))) + (cperl-test--validate-regexp cperl--version-regexp + valid invalid))) + +(ert-deftest cperl-test-package-regexp () + "Tests the regular expression of Perl package names with versions. +Also includes valid cases with whitespace in strange places." + (let ((valid + '("package Foo" + "package Foo::Bar" + "package Foo::Bar v1.2.3" + "package Foo::Bar::Baz 1.1" + "package \nFoo::Bar\n 1.00")) + (invalid + '("package Foo;" ; semicolon must not be included + "package Foo 1.1 {" ; nor the opening brace + "packageFoo" ; not a package declaration + "package Foo1.1" ; invalid package name + "class O3D::Sphere"))) ; class not yet supported + (cperl-test--validate-regexp cperl--package-regexp + valid invalid))) + +;;; Function test: Building an index for imenu + +(ert-deftest cperl-test-imenu-index () + "Test index creation for imenu. +This test relies on the specific layout of the index alist as +created by CPerl mode, so skip it for Perl mode." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (with-temp-buffer + (insert-file (ert-resource-file "grammar.pl")) + (cperl-mode) + (let ((index (cperl-imenu--create-perl-index)) + current-list) + (setq current-list (assoc-string "+Unsorted List+..." index)) + (should current-list) + (let ((expected '("(main)::outside" + "Package::in_package" + "Shoved::elsewhere" + "Package::prototyped" + "Versioned::Package::versioned" + "Block::attr" + "Versioned::Package::outer" + "lexical" + "Versioned::Block::signatured" + "Package::in_package_again"))) + (dolist (sub expected) + (should (assoc-string sub index))))))) + ;;; Tests for issues reported in the Bug Tracker (defun cperl-test--run-bug-10483 () -- cgit v1.2.3 From 90f54aad5e978653f5a590cdfb68090a0f9a25fc Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Tue, 8 Jun 2021 23:23:25 +0200 Subject: ; perl-mode.el: Detect regexes immediately after "|&" * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Add "|&" to the list of characters after which a slash starts a regular expression (Bug#23992). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-ppss): Correct the docstring. (cperl-test-bug-23992): New test for Bug#23992. (cperl-test-bug-42168): Adapt inline comments to the current code. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl: Resource file with example code from the bug report. --- lisp/progmodes/perl-mode.el | 2 +- .../cperl-mode-resources/cperl-bug-23992.pl | 10 ++++++++ test/lisp/progmodes/cperl-mode-tests.el | 30 ++++++++++++++++++---- 3 files changed, 36 insertions(+), 6 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index fd23683bc0a..d13c9053d57 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -285,7 +285,7 @@ (put-text-property (match-beginning 2) (match-end 2) 'syntax-table (string-to-syntax "\"")) (perl-syntax-propertize-special-constructs end))))) - ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)" + ("\\(^\\|[?:.,;=|&!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)" ;; Nasty cases: ;; /foo/m $a->m $#m $m @m %m ;; \s (appears often in regexps). diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl new file mode 100644 index 00000000000..1db639c6aa2 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl @@ -0,0 +1,10 @@ +# Test file for Bug#23992 +# +# The "||" case is directly from the report, +# the "&&" case has been added for symmetry. + +s/LEFT/L/g || s/RIGHT/R/g || s/aVALUE\D+//g; +s/LEFT/L/g||s/RIGHT/R/g||s/aVALUE\D+//g; + +s/LEFT/L/g && s/RIGHT/R/g && s/aVALUE\D+//g; +s/LEFT/L/g&&s/RIGHT/R/g&&s/aVALUE\D+//g; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 7cdfa45d6f7..036e20d7cca 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -37,7 +37,7 @@ ;;; Utilities (defun cperl-test-ppss (text regexp) - "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT." + "Return the `syntax-ppss' after the last character matched by REGEXP in TEXT." (interactive) (with-temp-buffer (insert text) @@ -377,6 +377,26 @@ documentation it does the right thing anyway." (cperl-indent-command) (forward-line 1)))) +(ert-deftest cperl-test-bug-23992 () + "Verify that substitutions are fontified directly after \"|&\". +Regular expressions are strings in both perl-mode and cperl-mode." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-23992.pl")) + (funcall cperl-test-mode) + (goto-char (point-min)) + ;; "or" operator, with spaces + (search-forward "RIGHT") + (should (nth 3 (syntax-ppss))) + ;; "or" operator, without spaces + (search-forward "RIGHT") + (should (nth 3 (syntax-ppss))) + ;; "and" operator, with spaces + (search-forward "RIGHT") + (should (nth 3 (syntax-ppss))) + ;; "and" operator, without spaces + (search-forward "RIGHT") + (should (nth 3 (syntax-ppss))))) + (ert-deftest cperl-test-bug-28650 () "Verify that regular expressions are recognized after 'return'. The test uses the syntax property \"inside a string\" for the @@ -448,14 +468,14 @@ If seen as regular expression, then the slash is displayed using font-lock-constant-face. If seen as a division, then it doesn't have a face property." :tags '(:fontification) - ;; The next two Perl expressions have divisions. Perl "punctuation" - ;; operators don't get a face. + ;; The next two Perl expressions have divisions. The slash does not + ;; start a string. (let ((code "{ $a++ / $b }")) (should (equal (nth 8 (cperl-test-ppss code "/")) nil))) (let ((code "{ $a-- / $b }")) (should (equal (nth 8 (cperl-test-ppss code "/")) nil))) - ;; The next two Perl expressions have regular expressions. The - ;; delimiter of a RE is fontified with font-lock-constant-face. + ;; The next two Perl expressions have regular expressions. The slash + ;; starts a string. (let ((code "{ $a+ / $b } # /")) (should (equal (nth 8 (cperl-test-ppss code "/")) 7))) (let ((code "{ $a- / $b } # /")) -- cgit v1.2.3 From dd9385b404c28a155a91960a4f1c4c77fdc5413d Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Wed, 9 Jun 2021 22:58:53 +0200 Subject: ; perl-mode.el: Detect quote-like operator immediately after => * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Detect a quotelike operator immediately after a fat comma "=>" (Bug#25098) * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-25098): Test case for the bug with code from the bug report. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl: Resource file for the test. --- lisp/progmodes/perl-mode.el | 2 +- .../cperl-mode-resources/cperl-bug-25098.pl | 21 +++++++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 18 ++++++++++++++++++ 3 files changed, 40 insertions(+), 1 deletion(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index d13c9053d57..a20887621e8 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -285,7 +285,7 @@ (put-text-property (match-beginning 2) (match-end 2) 'syntax-table (string-to-syntax "\"")) (perl-syntax-propertize-special-constructs end))))) - ("\\(^\\|[?:.,;=|&!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)" + ("\\(^\\|[?:.,;=|&!~({[ \t]\\|=>\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)" ;; Nasty cases: ;; /foo/m $a->m $#m $m @m %m ;; \s (appears often in regexps). diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl new file mode 100644 index 00000000000..0987b4e02c0 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl @@ -0,0 +1,21 @@ +# Code from the bug report Bug#25098 + +my $good = XML::LibXML->load_xml( string => q{
}); +my $bad = XML::LibXML->load_xml( string =>q{
}); + +# Related: Method calls are no quotelike operators. That's why you +# can't just add '>' to the character class. + +my $method_call = $object->q(argument); + +# Also related, still not fontified correctly: +# +# my $method_call = $object -> q (argument); +# +# perl-mode interprets the method call as a quotelike op (because it +# is preceded by a space). +# cperl-mode gets the argument right, but marks q as a quotelike op. +# +# my $greater = 2>q/1/; +# +# perl-mode doesn't identify this as a quotelike op. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 036e20d7cca..dcf4f398c29 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -397,6 +397,24 @@ Regular expressions are strings in both perl-mode and cperl-mode." (search-forward "RIGHT") (should (nth 3 (syntax-ppss))))) +(ert-deftest cperl-test-bug-25098 () + "Verify that a quotelike operator is recognized after a fat comma \"=>\". +Related, check that calling a method named q is not mistaken as a +quotelike operator." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-25098.pl")) + (funcall cperl-test-mode) + (goto-char (point-min)) + ;; good example from the bug report, with a space + (search-forward "q{") + (should (nth 3 (syntax-ppss))) + ;; bad (but now fixed) example from the bug report, without space + (search-forward "q{") + (should (nth 3 (syntax-ppss))) + ;; calling a method "q" (parens instead of braces to make it valid) + (search-forward "q(") + (should-not (nth 3 (syntax-ppss))))) + (ert-deftest cperl-test-bug-28650 () "Verify that regular expressions are recognized after 'return'. The test uses the syntax property \"inside a string\" for the -- cgit v1.2.3 From 87bd14ca8bdecda6964aeb3c323faee846a8c1b8 Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Fri, 11 Jun 2021 13:52:45 +0200 Subject: ; perl-mode.el: Allow newline between quote-likes and delimiter * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Allow newline between a quote-like operator and its delimiter (Bug#22355). * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-22355): Test case for the fix. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl: Test resource for a quote-like with newline before the delimiter. --- lisp/progmodes/perl-mode.el | 2 +- .../lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl | 14 ++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 11 +++++++++++ 3 files changed, 26 insertions(+), 1 deletion(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index a20887621e8..f49ee4cb2b5 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -285,7 +285,7 @@ (put-text-property (match-beginning 2) (match-end 2) 'syntax-table (string-to-syntax "\"")) (perl-syntax-propertize-special-constructs end))))) - ("\\(^\\|[?:.,;=|&!~({[ \t]\\|=>\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)" + ("\\(^\\|[?:.,;=|&!~({[ \t]\\|=>\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\(?:\\s-\\|\n\\)*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)" ;; Nasty cases: ;; /foo/m $a->m $#m $m @m %m ;; \s (appears often in regexps). diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl new file mode 100644 index 00000000000..f54d55241df --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl @@ -0,0 +1,14 @@ +# The source file contains non-ASCII characters, supposed to be saved +# in UTF-8 encoding. Tell Perl about that, just in case. +use utf8; + +# Following code is the example from the report Bug#22355 which needed +# attention in perl-mode. + +printf qq +{ + + + 台灣 %s 廣播電台 + +}, uc( substr( $ARGV[0], 0, 2 ) ), $year + 1900, $mon + 1, $mday; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index dcf4f398c29..4d2bac6ee47 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -377,6 +377,17 @@ documentation it does the right thing anyway." (cperl-indent-command) (forward-line 1)))) +(ert-deftest cperl-test-bug-22355 () + "Verify that substitutions are fontified directly after \"|&\". +Regular expressions are strings in both perl-mode and cperl-mode." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-22355.pl")) + (funcall cperl-test-mode) + (goto-char (point-min)) + ;; Just check for the start of the string + (search-forward "{") + (should (nth 3 (syntax-ppss))))) + (ert-deftest cperl-test-bug-23992 () "Verify that substitutions are fontified directly after \"|&\". Regular expressions are strings in both perl-mode and cperl-mode." -- cgit v1.2.3 From 0cabf8bc363cdeace84523b251752c0aac32b31b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 3 Sep 2021 11:13:53 +0200 Subject: ; Fix typos --- ChangeLog.2 | 2 +- ChangeLog.3 | 12 ++++++------ admin/nt/dist-build/build-zips.sh | 2 +- configure.ac | 2 +- doc/lispref/display.texi | 2 +- etc/NEWS | 2 +- etc/refcards/pl-refcard.tex | 2 +- lib-src/etags.c | 2 +- lisp/ChangeLog.7 | 2 +- lisp/ChangeLog.8 | 2 +- lisp/bookmark.el | 2 +- lisp/emacs-lisp/comp-cstr.el | 2 +- lisp/emacs-lisp/map-ynp.el | 2 +- lisp/erc/erc.el | 2 +- lisp/language/japan-util.el | 2 +- lisp/net/dictionary.el | 2 +- lisp/progmodes/cc-awk.el | 2 +- lisp/progmodes/cc-engine.el | 2 +- lisp/progmodes/elisp-mode.el | 2 +- lisp/progmodes/hideif.el | 2 +- lisp/progmodes/vhdl-mode.el | 2 +- lisp/textmodes/bibtex.el | 8 ++++---- lisp/windmove.el | 2 +- src/fns.c | 2 +- src/frame.c | 2 +- src/image.c | 4 ++-- src/nsterm.m | 4 ++-- test/lisp/net/socks-tests.el | 2 +- test/lisp/progmodes/cperl-mode-resources/here-docs.pl | 2 +- test/lisp/textmodes/fill-tests.el | 4 ++-- 30 files changed, 41 insertions(+), 41 deletions(-) (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/ChangeLog.2 b/ChangeLog.2 index 7b40c54dc64..3e227675e0d 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -35670,7 +35670,7 @@ 2015-04-08 Artur Malabarba * lisp/emacs-lisp/package.el (package-menu-mode): Mode-line notification - while dowloading information. + while downloading information. * lisp/emacs-lisp/package.el: More conservative `ensure-init-file' (package--ensure-init-file): Check file contents before visiting. diff --git a/ChangeLog.3 b/ChangeLog.3 index 8b872a0726e..9ec19e91d7f 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -33355,9 +33355,9 @@ Fix the handling of font backend supersedence on MS-Windows * src/w32font.c (syms_of_w32font): Don't make the Uniscribe - font backend "superceded" here, ... + font backend "superseded" here, ... * src/w32uniscribe.c (syms_of_w32uniscribe_for_pdumper): - ... make it "superceded" here, only if the HarfBuzz DLL was + ... make it "superseded" here, only if the HarfBuzz DLL was successfully loaded. This is because Emacs compiled with HarfBuzz support might run on a system without the DLL. * src/w32fns.c (Fx_create_frame, w32_create_tip_frame): @@ -36933,7 +36933,7 @@ electric--sort-post-self-insertion-hook. * lisp/emacs-lisp/syntax.el (syntax-propertize, syntax-ppss): - Use new `depth` arg to make sure noone accidentally gets added + Use new `depth` arg to make sure no one accidentally gets added after syntax-ppss-flush-cache. * doc/lispref/modes.texi (Setting Hooks): Document new `depth` arg. @@ -58138,7 +58138,7 @@ Use bignums when Emacs converts to and from system types like off_t for file sizes whose values can exceed fixnum range. - Formerly, Emacs sometimes generted floats and sometimes ad-hoc + Formerly, Emacs sometimes generated floats and sometimes ad-hoc conses of integers. Emacs still accepts floats and conses for these system types, in case some stray Lisp code is generating them, though this usage is obsolescent. @@ -133272,7 +133272,7 @@ (g_b_init_compare_string_w): Move declaration to file scope. * src/w32heap.c (dumped_data_commit): Now static. (FREEABLE_P): Avoid warnings about pointer comparison with integer. - (mmap_realloc): Cast to 'char *' for arithmetics on void pointers. + (mmap_realloc): Cast to 'char *' for arithmetic on void pointers. * src/w32console.c (ctrl_c_handler, sys_tputs, sys_tgetstr) (evalcost, cmputc, cmcheckmagic, cmcostinit, cmgoto, Wcm_clear): Provide prototypes. @@ -144146,7 +144146,7 @@ Move package test files to new directory. - * test/lisp/emacs-lisp/package-tests.el: Update resoruce file location. + * test/lisp/emacs-lisp/package-tests.el: Update resource file location. * test/data/package: Moved to test/lisp/emacs-lisp/package-resources 2015-11-24 Phillip Lord diff --git a/admin/nt/dist-build/build-zips.sh b/admin/nt/dist-build/build-zips.sh index 7bc6ea6a9e5..4c3a52af6a7 100755 --- a/admin/nt/dist-build/build-zips.sh +++ b/admin/nt/dist-build/build-zips.sh @@ -134,7 +134,7 @@ while getopts "gb:hnsiV:" opt; do echo " -g git update and worktree only" echo " -i build installer only" echo " -n do not configure" - echo " -s snaphot build" + echo " -s snapshot build" exit 0 ;; \?) diff --git a/configure.ac b/configure.ac index 6d204b61030..418a62fd5ea 100644 --- a/configure.ac +++ b/configure.ac @@ -5667,7 +5667,7 @@ gl_INIT CFLAGS=$SAVE_CFLAGS LIBS=$SAVE_LIBS -# timer_getoverrun needs the same libarary as timer_settime +# timer_getoverrun needs the same library as timer_settime OLD_LIBS=$LIBS LIBS="$LIB_TIMER_TIME $LIBS" AC_CHECK_FUNCS(timer_getoverrun) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 7ab2896778d..ca438c10ce2 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5970,7 +5970,7 @@ To @var{svg} add an embedded (raster) image placed at @code{:base-uri} specifies a (possibly non-existing) file name of the svg image to be created, thus all the embedded files are searched relatively to the @code{:base-uri} filename's directory. If -@code{:base-uri} is ommited, then filename from where svg image is +@code{:base-uri} is omitted, then filename from where svg image is loaded is used. Using @code{:base-uri} improves the performance of embedding large images, comparing to @code{svg-embed}, because all the work is done directly by librsvg. diff --git a/etc/NEWS b/etc/NEWS index 0fe988a19ce..3fede93eae6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3181,7 +3181,7 @@ refers to the old state at FROM. +++ ** 'overlays-in' now handles zero-length overlays slightly differently. -Previosly, zero-length overlays at the end of the buffer were included +Previously, zero-length overlays at the end of the buffer were included in the result (if the region queried for stopped at that position). The same was not the case if the buffer had been narrowed to exclude the real end of the buffer. This has now been changed, and diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex index c9d96788c5d..5c12dbfbf57 100644 --- a/etc/refcards/pl-refcard.tex +++ b/etc/refcards/pl-refcard.tex @@ -679,7 +679,7 @@ Napisz \kbd{F10} aby uaktywni/c menu w minibuforze. \key{przestaw {\bf linie}}{C-x C-t} \key{przestaw {\bf s-wyra/zenia}}{C-M-t} -% Removed -- there is no Polish disctionary for ispell. +% Removed -- there is no Polish dictionary for ispell. %\section{Spelling Check} % %\key{check spelling of current word}{M-\$} diff --git a/lib-src/etags.c b/lib-src/etags.c index 88b49f803e9..bd4d4fcf53a 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -6259,7 +6259,7 @@ test_objc_is_mercury (char *this_file, language **lang) } } - /* Fallback heuristic test. Not failsafe but errless in pratice. */ + /* Fallback heuristic test. Not failsafe but errless in practice. */ ratio = ((float) rule_signs + percentage_signs + mercury_dots) / lines; out: diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index 3de3f2f1571..3dd8313c6a3 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -15867,7 +15867,7 @@ the key line of an entry. * bibtex.el (bibtex-autokey-year-use-crossref-entry): New variable - to determine if crossreferenced entry should be used for autokey + to determine if cross-referenced entry should be used for autokey generation, if year field of current entry is absent. (bibtex-generate-autokey): Use this new variable. diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8 index 3027463e539..39e757bfff1 100644 --- a/lisp/ChangeLog.8 +++ b/lisp/ChangeLog.8 @@ -1147,7 +1147,7 @@ (bibtex-submit-bug-report): Use bibtex-version and bibtex-maintainer-salutation. (bibtex-entry-field-alist): Made booktitle field optional for - @inproceedings entries when crossreferenced. + @inproceedings entries when cross-referenced. (bibtex-entry-field-alist): Add booktitle field to proceedings entry type (for cross referencing). Thanks to Wagner Toledo Correa for the suggestion. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index ff9b8ab1388..b340d379b3f 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -27,7 +27,7 @@ ;; associates a string with a location in a certain file. Thus, you ;; can navigate your way to that location by providing the string. ;; -;; Type `M-x customize-group RET boomark RET' for user options. +;; Type `M-x customize-group RET bookmark RET' for user options. ;;; Code: diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 3c5578217aa..6a3f6046d1c 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -152,7 +152,7 @@ Integer values are handled in the `range' slot.") (defun comp-cstrs-homogeneous (cstrs) "Check if constraints CSTRS are all homogeneously negated or non-negated. Return `pos' if they are all positive, `neg' if they are all -negated or nil othewise." +negated or nil otherwise." (cl-loop for cstr in cstrs unless (comp-cstr-neg cstr) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 0522b31f577..b95f11eab64 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -79,7 +79,7 @@ of the alist has the form (KEY FUNCTION HELP), where KEY is a character; FUNCTION is a function of one argument (an object from LIST); and HELP is a string. When the user presses KEY, FUNCTION is called; if it returns non-nil, the object is considered to have been \"acted upon\", -and `map-y-or-n-p' proceeeds to the next object from LIST. If +and `map-y-or-n-p' proceeds to the next object from LIST. If FUNCTION returns nil, the prompt is re-issued for the same object: this comes in handy if FUNCTION produces some display that will allow the user to make an intelligent decision whether the object in question diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 73202016ba7..e0fda41f8ed 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2271,7 +2271,7 @@ first element is the certificate key file name, and the second element is the certificate file name itself, or t, which means that `auth-source' will be queried for the key and the certificate. Authenticating using a TLS client certificate is -also refered to as \"CertFP\" (Certificate Fingerprint) +also referred to as \"CertFP\" (Certificate Fingerprint) authentication by various IRC networks. Example usage: diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index f3e3590645b..feb75a198e2 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -145,7 +145,7 @@ and HANKAKU belongs to `japanese-jisx0201-kana'.") (?ｐ . ?p) (?ｑ . ?q) (?ｒ . ?r) (?ｓ . ?s) (?ｔ . ?t) (?ｕ . ?u) (?ｖ . ?v) (?ｗ . ?w) (?ｘ . ?x) (?ｙ . ?y) (?ｚ . ?z)) "Japanese JISX0208 alpha numeric character table. -Each element is of the form (ALPHA-NUMERIC . ASCII), where ALPHA-NUMERIC +Each element is of the form (ALPHANUMERIC . ASCII), where ALPHANUMERIC belongs to `japanese-jisx0208', ASCII belongs to `ascii'.") ;; Put properties 'jisx0208 and 'ascii to each Japanese alpha numeric diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index f33cbaf1126..0f42af0911b 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -86,7 +86,7 @@ You can specify here: (defcustom dictionary-port 2628 "The port of the dictionary server. -This port is propably always 2628 so there should be no need to modify it." +This port is probably always 2628 so there should be no need to modify it." :group 'dictionary :set #'dictionary-set-server-var :type 'number diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 334e82114fc..f1bc25db7f7 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -658,7 +658,7 @@ ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; Fontification". ;; - ;; This function gives invalid GAWK namepace separators (::) + ;; This function gives invalid GAWK namespace separators (::) ;; font-lock-warning-face. "Invalid" here means there are spaces, etc., ;; around a separator, or there are more than one of them in an identifier. ;; Invalid separators inside function declaration parentheses are handled diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index c305cae754e..77da98f6262 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7422,7 +7422,7 @@ multi-line strings (but not C++, for example)." t) (save-excursion (goto-char (match-end 1)) - (if (c-in-literal) ; a psuedo closer. + (if (c-in-literal) ; a pseudo closer. t (setq saved-match-data (match-data)) (setq found t) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 542f8ad0b1b..ef36c1f0877 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1452,7 +1452,7 @@ Elisp eldoc behaviour. Consider variable docstrings and function signatures only, in this order. If none applies, returns nil. Changes to `eldoc-documentation-functions' and `eldoc-documentation-strategy' are _not_ reflected here. As such -it is preferrable to use ElDoc's interfaces directly.") +it is preferable to use ElDoc's interfaces directly.") (make-obsolete 'elisp-eldoc-documentation-function "use ElDoc's interfaces instead." "28.1") diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 4a1da62c7e9..a2f5d7286ac 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -682,7 +682,7 @@ that form should be displayed.") (defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) (defconst hif-token-regexp - ;; The ordering of regexp grouping is crutial to `hif-strtok' + ;; The ordering of regexp grouping is crucial to `hif-strtok' (concat ;; hex/binary: "\\([+-]?0[xXbB]\\([[:xdigit:]']+\\)?\\.?\\([[:xdigit:]']+\\)?\\([pP]\\([+-]?[0-9]+\\)\\)?" diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 5eeac8af3b8..3fe67fabf19 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -4700,7 +4700,7 @@ Usage: `vhdl-project-alist'. - SPECIAL MENUES: + SPECIAL MENUS: As an alternative to the speedbar, an index menu can be added (set option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu (e.g. add \"(global-set-key [S-down-mouse-3] \\='imenu)\" to your start-up diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 5cece1aa3c6..d5671ce14f9 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -113,7 +113,7 @@ page-dashes Change double dashes in page field to single dash whitespace Delete whitespace at the beginning and end of fields. inherit-booktitle If entry contains a crossref field and the booktitle field is empty, set the booktitle field to the content - of the title field of the crossreferenced entry. + of the title field of the cross-referenced entry. realign Realign entries, so that field texts and perhaps equal signs (depending on the value of `bibtex-align-at-equal-sign') begin in the same column. @@ -1228,9 +1228,9 @@ See `bibtex-generate-autokey' for details." :type 'integer) (defcustom bibtex-autokey-use-crossref t - "If non-nil use fields from crossreferenced entry if necessary. + "If non-nil use fields from cross-referenced entry if necessary. If this variable is non-nil and some field has no entry, but a -valid crossref entry, the field from the crossreferenced entry is used. +valid crossref entry, the field from the cross-referenced entry is used. See `bibtex-generate-autokey' for details." :group 'bibtex-autokey :type 'boolean) @@ -2975,7 +2975,7 @@ The year part: `bibtex-autokey-year-length' digits (useful values are 2 and 4). 2. If both the year and date fields are absent, but the entry has a valid crossref field and `bibtex-autokey-use-crossref' is - non-nil, use the date or year field of the crossreferenced entry + non-nil, use the date or year field of the cross-referenced entry instead. The title part diff --git a/lisp/windmove.el b/lisp/windmove.el index f747c409431..ef970bb6c96 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -170,7 +170,7 @@ placement bugs in old versions of Emacs." (defcustom windmove-allow-all-windows nil "Whether the windmove commands are allowed to target all type of windows. -If this variable is set to non-nil, all windmove commmands will +If this variable is set to non-nil, all windmove commands will ignore the `no-other-window' parameter applied by `display-buffer-alist' or `set-window-parameter'." :type 'boolean diff --git a/src/fns.c b/src/fns.c index 5126439fd66..c39fce21c70 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1174,7 +1174,7 @@ string_make_multibyte (Lisp_Object string) /* Convert STRING (if unibyte) to a multibyte string without changing - the number of characters. Characters 0200 trough 0237 are + the number of characters. Characters 0200 through 0237 are converted to eight-bit characters. */ Lisp_Object diff --git a/src/frame.c b/src/frame.c index ab5dcc3664c..f95566818af 100644 --- a/src/frame.c +++ b/src/frame.c @@ -729,7 +729,7 @@ adjust_frame_size (struct frame *f, int new_text_width, int new_text_height, && (f->new_width >= 0 || f->new_height >= 0)) /* For implied resizes with inhibit 2 (external menu and tool bar) pick up any new sizes the display engine has not - processed yet. Otherwsie, we would request the old sizes + processed yet. Otherwise, we would request the old sizes which will make this request appear as a request to set new sizes and have the WM react accordingly which is not TRT. diff --git a/src/image.c b/src/image.c index bcd45eb4514..206c7baa2f8 100644 --- a/src/image.c +++ b/src/image.c @@ -10039,7 +10039,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, #if LIBRSVG_CHECK_VERSION (2, 46, 0) RsvgRectangle zero_rect, viewbox, out_logical_rect; - /* Try the instrinsic dimensions first. */ + /* Try the intrinsic dimensions first. */ gboolean has_width, has_height, has_viewbox; RsvgLength iwidth, iheight; double dpi = FRAME_DISPLAY_INFO (f)->resx; @@ -10074,7 +10074,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, } else { - /* We haven't found a useable set of sizes, so try working out + /* We haven't found a usable set of sizes, so try working out the visible area. */ rsvg_handle_get_geometry_for_layer (rsvg_handle, NULL, &zero_rect, &viewbox, diff --git a/src/nsterm.m b/src/nsterm.m index 4bdc67c10b5..8d88f7bd3de 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -8369,14 +8369,14 @@ not_in_argv (NSString *arg) #ifdef NS_IMPL_COCOA - /* We have to set the accesibility subroles and/or the collection + /* We have to set the accessibility subroles and/or the collection behaviors early otherwise child windows may not go fullscreen as expected later. */ #if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) #endif - /* Set the accessibilty subroles. */ + /* Set the accessibility subroles. */ if (parentFrame) [self setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole]; else diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 71bdd74890a..c0f90bc2d47 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -95,7 +95,7 @@ ;; From fedora.org: 2605:bc80:3010:600:dead:beef:cafe:fed9 ;; 5004 ~~> Version Status (OK) NOOP Addr-Type (4 -> IPv6) (socks-filter proc "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60") - (ert-info ("State still waiting and response emtpy") + (ert-info ("State still waiting and response empty") (should (eq (process-get proc 'socks-state) socks-state-waiting)) (should-not (process-get proc 'socks-response))) (ert-info ("Scratch field holds partial payload of pending msg") diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl index 8af4625fff3..bb3d4871a91 100644 --- a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl +++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl @@ -17,7 +17,7 @@ For each of the HERE documents, the following checks will done: =item * -All occurrences of the string "look-here" are fontified correcty. +All occurrences of the string "look-here" are fontified correctly. Note that we deliberately test the face, not the syntax property: Users won't care for the syntax property, but they see the face. Different implementations with different syntax properties have been diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el index a4c7f447b59..fcc2c757091 100644 --- a/test/lisp/textmodes/fill-tests.el +++ b/test/lisp/textmodes/fill-tests.el @@ -54,7 +54,7 @@ (beg (line-beginning-position)) (end (line-end-position)) (fill-prefix (make-string (- pos beg) ?\s)) - ;; `fill-column' is too small to accomodate the current line + ;; `fill-column' is too small to accommodate the current line (fill-column (- end beg 10))) (fill-region-as-paragraph beg end nil nil pos)) (should (equal (buffer-string) string))))) @@ -69,7 +69,7 @@ (beg (line-beginning-position)) (end (line-end-position)) (fill-prefix (make-string (- pos beg) ?\s)) - ;; `fill-column' is too small to accomodate the current line + ;; `fill-column' is too small to accommodate the current line (fill-column (- end beg 10))) (fill-region-as-paragraph beg end nil nil pos)) (should (equal -- cgit v1.2.3 From 3d49ad73e5a93625629c96b6c0b921bb019ea9da Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Tue, 14 Sep 2021 17:53:52 +0200 Subject: cperl-mode.el: Allow non-ASCII Perl identifiers Replace all "A-Z" regexp literals with unicode-aware rx constructs wherever Perl allows non-ASCII identifiers. * lisp/progmodes/cperl-mode.el (cperl-after-sub-regexp) (cperl-after-label. cperl-sniff-for-indent) (cperl-find-pods-heres, cperl-indent-exp) (cperl-fix-line-spacing, cperl-imenu--create-perl-index) (cperl-init-faces, cperl-find-tags): Replace ASCII regex literals by unicode-aware rx constructs. (cperl-init-faces): Eliminate unused lexical `font-lock-anchored'. (cperl-have-help-regexp, cperl-word-at-point-hard): Allow non-ASCII word characters. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-fontify-special-variables): New test for $^T and $^{VARNAME}. (cperl-test-ws-rx cperl-test-ws+-rx), (cperl-test-version-regexp, cperl-test-package-regexp): Skip for perl-mode. (cperl-test-identifier-rx, cperl--test-unicode-setup) (cperl-test-unicode-labels, cperl-test-unicode-sub) (cperl-test-unicode-varname) (cperl-test-unicode-varname-list, cperl-test-unicode-arrays) (cperl-test-unicode-hashes, cperl-test-unicode-hashref) (cperl-test-unicode-proto, cperl-test-unicode-fhs) (cperl-test-unicode-hashkeys, cperl-test-word-at-point): New tests for unicode identifiers. (cperl-test-imenu-index): Add a unicode identifier to the test. * test/lisp/progmodes/cperl-mode-resources/grammar.pl: Add a function with non-ASCII name for imenu tests. --- lisp/progmodes/cperl-mode.el | 330 ++++++++++++++------- .../lisp/progmodes/cperl-mode-resources/grammar.pl | 14 + test/lisp/progmodes/cperl-mode-tests.el | 301 ++++++++++++++++++- 3 files changed, 545 insertions(+), 100 deletions(-) (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 76c82f8c73e..1147889969b 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1407,7 +1407,7 @@ the last)." (concat ; Assume n groups before this... "\\(" ; n+1=name-group cperl-white-and-comment-rex ; n+2=pre-name - "\\(::[a-zA-Z_0-9:']+\\|[a-zA-Z_'][a-zA-Z_0-9:']*\\)" ; n+3=name + (rx-to-string `(group ,cperl--normal-identifier-rx)) "\\)" ; END n+1=name-group (if named "" "?") "\\(" ; n+4=proto-group @@ -2573,7 +2573,8 @@ Return the amount the indentation changed by." '(?w ?_)) (progn (backward-sexp) - (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))) + (looking-at (rx (sequence (eval cperl--label-rx) + (not (in ":")))))))) (defun cperl-get-state (&optional parse-start start-state) "Return list (START STATE DEPTH PRESTART), @@ -2740,7 +2741,9 @@ Will not look before LIM." (progn (forward-sexp -1) (skip-chars-backward " \t") - (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))) + (looking-at + (rx (sequence (0+ blank) + (eval cperl--label-rx)))))) (get-text-property (point) 'first-format-line))) ;; Look at previous line that's at column 0 @@ -3836,7 +3839,8 @@ recursive calls in starting lines of here-documents." "\\<" cperl-sub-regexp "\\>" ; sub with proto/attr "\\(" cperl-white-and-comment-rex - "\\(::[a-zA-Z_:'0-9]*\\|[a-zA-Z_'][a-zA-Z_:'0-9]*\\)\\)?" ; name + (rx (group (eval cperl--normal-identifier-rx))) + "\\)" "\\(" cperl-maybe-white-and-comment-rex "\\(([^()]*)\\|:[^:]\\)\\)" ; prototype or attribute start @@ -4111,10 +4115,12 @@ recursive calls in starting lines of here-documents." (t t)))) ;; or <$file> (and (eq c ?\<) - ;; Do not stringify , <$fh> : + ;; Stringify what looks like a glob, but + ;; do not stringify file handles , <$fh> : (save-match-data (looking-at - "\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\)?>")))) + (rx (sequence (opt "$") + (eval cperl--normal-identifier-rx))))))) tb (match-beginning 0)) (goto-char (match-beginning b1)) (cperl-backward-to-noncomment (point-min)) @@ -4184,7 +4190,16 @@ recursive calls in starting lines of here-documents." (error nil))) (if (or bb (looking-at ; $foo -> {s} - "[$@]\\$*\\([a-zA-Z0-9_:]+\\|[^{]\\)\\([ \t\n]*->\\)?[ \t\n]*{") + (rx + (sequence + (in "$@") (0+ "$") + (or + (eval cperl--normal-identifier-rx) + (not (in "{"))) + (opt (sequence (eval cperl--ws*-rx)) + "->") + (eval cperl--ws*-rx) + "{"))) (and ; $foo[12] -> {s} (memq (following-char) '(?\{ ?\[)) (progn @@ -4199,7 +4214,12 @@ recursive calls in starting lines of here-documents." (setq bb t)) ((and (eq (following-char) ?:) (eq b1 ?\{) ; Check for $ { s::bar } - (looking-at "::[a-zA-Z0-9_:]*[ \t\n\f]*}") + ;; (looking-at "::[a-zA-Z0-9_:]*[ \t\n\f]*}") + (looking-at + (rx (sequence "::" + (eval cperl--normal-identifier-rx) + (eval cperl--ws*-rx) + "}"))) (progn (goto-char (1- go)) (skip-chars-backward " \t\n\f") @@ -4364,7 +4384,7 @@ recursive calls in starting lines of here-documents." "\\(" ;; XXXX 1-char variables, exc. |()\s "[$@]" "\\(" - "[_a-zA-Z:][_a-zA-Z0-9:]*" + (rx (eval cperl--normal-identifier-rx)) "\\|" "{[^{}]*}" ; only one-level allowed "\\|" @@ -4820,6 +4840,7 @@ recursive calls in starting lines of here-documents." (progn (backward-sexp) ;; sub {BLK}, print {BLK} $data, but NOT `bless', `return', `tr', `constant' + ;; a-zA-Z is fine here, these are Perl keywords (or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\|constant\\)\\>"))) ;; sub bless::foo {} @@ -5028,7 +5049,11 @@ conditional/loop constructs." cperl-maybe-white-and-comment-rex "\\(state\\|my\\|local\\|our\\)\\)?" cperl-maybe-white-and-comment-rex - "\\$[_a-zA-Z0-9]+\\)?\\)\\>")) + (rx + (sequence + "$" + (eval cperl--basic-identifier-rx))) + "\\)?\\)\\>")) (progn (goto-char top) (forward-sexp 1) @@ -5122,7 +5147,14 @@ Returns some position at the last line." ;; Looking at: ;; foreach my $var ( (if (looking-at - "[ \t]*\\\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") + (rx (sequence + (0+ blank) + (opt (sequence "}" (0+ blank) )) + symbol-start + (or "else" "elsif" "continue" "if" "unless" "while" "until" + (sequence (or "for" "foreach") + (opt + (opt (sequence (1+ blank) + (or "state" "my" "local" "our"))) + (0+ blank) + "$" (eval cperl--basic-identifier-rx)))) + symbol-end + (group-n 1 + (or + (or (sequence (0+ blank) "(") + (sequence (eval cperl--ws*-rx) "{")) + (sequence (0+ blank) "{")))))) (progn - (setq ml (match-beginning 8)) ; "(" or "{" after control word + (setq ml (match-beginning 1)) ; "(" or "{" after control word (re-search-forward "[({]") (forward-char -1) (setq p (point)) @@ -5544,7 +5592,11 @@ comment, or POD." (setq lst index-sub-alist) (while lst (setq elt (car lst) lst (cdr lst)) - (cond ((string-match "\\(::\\|'\\)[_a-zA-Z0-9]+$" (car elt)) + (cond ((string-match + (rx (sequence (or "::" "'") + (eval cperl--basic-identifier-rx) + string-end)) + (car elt)) (setq pack (substring (car elt) 0 (match-beginning 0))) (if (setq group (assoc pack hier-list)) (if (listp (cdr group)) @@ -5646,8 +5698,7 @@ default function." (defun cperl-init-faces () (condition-case errs (progn - (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored) - (setq font-lock-anchored t) + (let (t-font-lock-keywords t-font-lock-keywords-1) (setq t-font-lock-keywords (list @@ -5760,20 +5811,41 @@ default function." (if (eq (char-after (cperl-1- (match-end 0))) ?\{ ) 'font-lock-function-name-face 'font-lock-variable-name-face)))) - '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t;]" ; require A if B; - 2 font-lock-function-name-face) + `(,(rx (sequence symbol-start + (or "package" "require" "use" "import" + "no" "bootstrap") + (eval cperl--ws+-rx) + (group-n 1 (eval cperl--normal-identifier-rx)) + (any " \t;"))) ; require A if B; + 1 font-lock-function-name-face) '("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$" 1 font-lock-function-name-face) - (cond (font-lock-anchored - '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - (2 font-lock-string-face t) - ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - nil nil - (1 font-lock-string-face t)))) - (t '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - 2 font-lock-string-face t))) - '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 - font-lock-string-face t) + ;; bareword hash key: $foo{bar} + `(,(rx (or (in "]}\\%@>*&") ; What Perl is this? + (sequence "$" (eval cperl--normal-identifier-rx))) + (0+ blank) "{" (0+ blank) + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "}") +;; '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + (1 font-lock-string-face t) + ;; anchored bareword hash key: $foo{bar}{baz} + (,(rx point + (0+ blank) "{" (0+ blank) + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "}") + ;; ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + nil nil + (1 font-lock-string-face t))) + ;; hash element assignments with bareword key => value + `(,(rx (in "[ \t{,()") + (group-n 1 (sequence (opt "-") + (eval cperl--basic-identifier-rx))) + (0+ blank) "=>") + 1 font-lock-string-face t) +;; '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 +;; font-lock-string-face t) ;; labels `(,(rx (sequence @@ -5797,83 +5869,130 @@ default function." ;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face) ;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)" ;;; (2 (cons font-lock-variable-name-face '(underline)))) - (cond (font-lock-anchored ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var - `(,(concat "\\<\\(state\\|my\\|local\\|our\\)" - cperl-maybe-white-and-comment-rex - "\\((" - cperl-maybe-white-and-comment-rex - "\\)?\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)") - (5 ,(if cperl-font-lock-multiline - 'font-lock-variable-name-face - '(progn (setq cperl-font-lock-multiline-start - (match-beginning 0)) - 'font-lock-variable-name-face))) - (,(concat "\\=" - cperl-maybe-white-and-comment-rex - "," - cperl-maybe-white-and-comment-rex - "\\([$@%*]\\([a-zA-Z0-9_:]+\\|[^a-zA-Z0-9_]\\)\\)") - ;; Bug in font-lock: limit is used not only to limit - ;; searches, but to set the "extend window for - ;; facification" property. Thus we need to minimize. - ,(if cperl-font-lock-multiline - '(if (match-beginning 3) - (save-excursion - (goto-char (match-beginning 3)) - (condition-case nil - (forward-sexp 1) - (error - (condition-case nil - (forward-char 200) - (error nil)))) ; typeahead - (1- (point))) ; report limit - (forward-char -2)) ; disable continued expr - '(if (match-beginning 3) - (point-max) ; No limit for continuation - (forward-char -2))) ; disable continued expr - ,(if cperl-font-lock-multiline - nil - '(progn ; Do at end - ;; "my" may be already fontified (POD), - ;; so cperl-font-lock-multiline-start is nil - (if (or (not cperl-font-lock-multiline-start) - (> 2 (count-lines - cperl-font-lock-multiline-start - (point)))) - nil - (put-text-property - (1+ cperl-font-lock-multiline-start) (point) - 'syntax-type 'multiline)) - (setq cperl-font-lock-multiline-start nil))) - (3 font-lock-variable-name-face)))) - (t '("^[ \t{}]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)" - 3 font-lock-variable-name-face))) - '("\\ 2 (count-lines + cperl-font-lock-multiline-start + (point)))) + nil + (put-text-property + (1+ cperl-font-lock-multiline-start) (point) + 'syntax-type 'multiline)) + (setq cperl-font-lock-multiline-start nil))) + (1 font-lock-variable-name-face))) + ;; foreach my $foo ( + `(,(rx symbol-start "for" (opt "each") + (opt (sequence (1+ blank) + (or "state" "my" "local" "our"))) + (0+ blank) + (group-n 1 (sequence "$" + (eval cperl--basic-identifier-rx))) + (0+ blank) "(") +;; '("\\") (setq search @@ -6472,6 +6593,9 @@ Will not move the position at the start to the left." "Run etags with appropriate options for Perl files. If optional argument ALL is `recursive', will process Perl files in subdirectories too." + ;; Apparently etags doesn't support UTF-8 encoded sources, and usage + ;; of etags has been commented out in the menu since ... well, + ;; forever. So, let's just stick to ASCII here. -- haj, 2021-09-14 (interactive) (let ((cmd "etags") (args `("-l" "none" "-r" @@ -6611,6 +6735,9 @@ Does not move point." ;; Search for the function (progn ;;save-match-data (while (re-search-forward + ;; FIXME: Should XS code be unicode aware? Recent C + ;; compilers (Gcc 10+) are, but I guess this isn't used + ;; much. -- haj, 2021-09-14 "^\\([ \t]*MODULE\\>[^\n]*\\\\|\\([a-zA-Z_][a-zA-Z_0-9]*\\)(\\|[ \t]*BOOT:\\)" nil t) (cond @@ -6673,7 +6800,7 @@ Does not move point." (setq lst (mapcar (lambda (elt) - (cond ((string-match "^[_a-zA-Z]" (car elt)) + (cond ((string-match (rx line-start (or alpha "_")) (car elt)) (goto-char (cdr elt)) (beginning-of-line) ; pos should be of the start of the line (list (car elt) @@ -6703,9 +6830,14 @@ Does not move point." "," (number-to-string (1- (elt elt 1))) ; Char pos 0-based "\n") - (if (and (string-match "^[_a-zA-Z]+::" (car elt)) - (string-match (concat "^" cperl-sub-regexp "[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]") - (elt elt 3))) + (if (and (string-match (rx line-start + (eval cperl--basic-identifier-rx) "++") + (car elt)) + (string-match (rx-to-string `(sequence line-start + (regexp ,cperl-sub-regexp) + (1+ (in " \t")) + ,cperl--normal-identifier-rx)) + (elt elt 3))) ;; Need to insert the name without package as well (setq lst (cons (cons (substring (elt elt 3) (match-beginning 1) @@ -7155,14 +7287,14 @@ Currently it is tuned to C and Perl syntax." ;;(concat "\\(" (mapconcat #'identity - '("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable + '("[$@%*&][[:alnum:]_:]+\\([ \t]*[[{]\\)?" ; Usual variable "[$@]\\^[a-zA-Z]" ; Special variable "[$@][^ \n\t]" ; Special variable "-[a-zA-Z]" ; File test "\\\\[a-zA-Z0]" ; Special chars "^=[a-z][a-zA-Z0-9_]*" ; POD sections "[-!&*+,./<=>?\\^|~]+" ; Operator - "[a-zA-Z_0-9:]+" ; symbol or number + "[[:alnum:]_:]+" ; symbol or number "x=" "#!") ;;"\\)\\|\\(" @@ -7178,7 +7310,7 @@ Currently it is tuned to C and Perl syntax." ;; Does not save-excursion ;; Get to the something meaningful (or (eobp) (eolp) (forward-char 1)) - (re-search-backward "[-a-zA-Z0-9_:!&*+,./<=>?\\^|~$%@]" + (re-search-backward "[-[:alnum:]_:!&*+,./<=>?\\^|~$%@]" (point-at-bol) 'to-beg) ;; (cond @@ -7187,8 +7319,8 @@ Currently it is tuned to C and Perl syntax." ;; (or (bobp) (backward-char 1)))) ;; Try to backtrace (cond - ((looking-at "[a-zA-Z0-9_:]") ; symbol - (skip-chars-backward "a-zA-Z0-9_:") + ((looking-at "[[:alnum:]_:]") ; symbol + (skip-chars-backward "[:alnum:]_:") (cond ((and (eq (preceding-char) ?^) ; $^I (eq (char-after (- (point) 2)) ?\$)) @@ -7199,7 +7331,7 @@ Currently it is tuned to C and Perl syntax." (eq (current-column) 1)) (forward-char -1))) ; =head1 (if (and (eq (preceding-char) ?\<) - (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; + (looking-at "\\$?[[:alnum:]_:]+>")) ; (forward-char -1))) ((and (looking-at "=") (eq (preceding-char) ?x)) ; x= (forward-char -1)) @@ -7212,15 +7344,15 @@ Currently it is tuned to C and Perl syntax." (not (eq (char-after (- (point) 2)) ?\$))) ; $- (forward-char -1)) ((and (eq (following-char) ?\>) - (string-match "[a-zA-Z0-9_]" (char-to-string (preceding-char))) + (string-match "[[:alnum:]_]" (char-to-string (preceding-char))) (save-excursion (forward-sexp -1) (and (eq (preceding-char) ?\<) - (looking-at "\\$?[a-zA-Z0-9_:]+>")))) ; + (looking-at "\\$?[[:alnum:]_:]+>")))) ; (search-backward "<")))) ((and (eq (following-char) ?\$) (eq (preceding-char) ?\<) - (looking-at "\\$?[a-zA-Z0-9_:]+>")) ; <$fh> + (looking-at "\\$?[[:alnum:]_:]+>")) ; <$fh> (forward-char -1))) (if (looking-at cperl-have-help-regexp) (buffer-substring (match-beginning 0) (match-end 0)))) diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl index c05fd7efc2a..96a86993082 100644 --- a/test/lisp/progmodes/cperl-mode-resources/grammar.pl +++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl @@ -1,6 +1,7 @@ use 5.024; use strict; use warnings; +use utf8; sub outside { say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}'"; @@ -155,4 +156,17 @@ package :: { Shoved::elsewhere(); +# Finally, try unicode identifiers. +package Erdős::Number; + +sub erdős_number { + my $name = shift; + if ($name eq "Erdős Pál") { + return 0; + } + else { + die "No access to the database. Sorry."; + } +} + 1; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 54012c3918e..29b9e3f6fb9 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -154,6 +154,22 @@ 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-special-variables () + "Test fontification of variables like $^T or ${^ENCODING}. +These can occur as \"local\" aliases." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (with-temp-buffer + (insert "local ($^I, ${^UNICODE});\n") + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward "$") + (should (equal (get-text-property (point) 'face) + 'font-lock-variable-name-face)) + (search-forward "$") + (should (equal (get-text-property (point) 'face) + 'font-lock-variable-name-face)))) + (ert-deftest cperl-test-identify-heredoc () "Test whether a construct containing \"<<\" followed by a bareword is properly identified for a here-document if @@ -297,6 +313,7 @@ the whole string." (ert-deftest cperl-test-ws-rx () "Tests capture of very simple regular expressions (yawn)." + (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid '(" " "\t" "\n")) (invalid @@ -306,6 +323,7 @@ the whole string." (ert-deftest cperl-test-ws+-rx () "Tests sequences of whitespace and comment lines." + (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid `(" " "\t#\n" "\n# \n" ,(concat "# comment\n" "# comment\n" "\n" "#comment\n"))) @@ -316,6 +334,7 @@ the whole string." (ert-deftest cperl-test-version-regexp () "Tests the regexp for recommended syntax of versions in Perl." + (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid '("1" "1.1" "1.1_1" "5.032001" "v120.100.103")) @@ -331,6 +350,7 @@ the whole string." (ert-deftest cperl-test-package-regexp () "Tests the regular expression of Perl package names with versions. Also includes valid cases with whitespace in strange places." + (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid '("package Foo" "package Foo::Bar" @@ -346,6 +366,284 @@ Also includes valid cases with whitespace in strange places." (cperl-test--validate-regexp (rx (eval cperl--package-rx)) valid invalid))) +(ert-deftest cperl-test-identifier-rx () + "Test valid and invalid identifiers (no sigils)." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((valid + '("foo" "FOO" "f_oo" "a123" + "manĝis")) ; Unicode is allowed! + (invalid + '("$foo" ; no sigils allowed (yet) + "Foo::bar" ; no package qualifiers allowed + "lots_of_€"))) ; € is not alphabetic + (cperl-test--validate-regexp (rx (eval cperl--basic-identifier-rx)) + valid invalid))) + +;;; Test unicode identifier in various places + +(defun cperl--test-unicode-setup (code string) + "Insert CODE, prepare it for tests, and find STRING. +Invoke the appropriate major mode, ensure fontification, and set +point after the first occurrence of STRING (no regexp!)." + (insert code) + (funcall cperl-test-mode) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward string)) + +(ert-deftest cperl-test-unicode-labels () + "Verify that non-ASCII labels are processed correctly." + (with-temp-buffer + (cperl--test-unicode-setup "LABEł: for ($manĝi) { say; }" "LAB") + (should (equal (get-text-property (point) 'face) + 'font-lock-constant-face)))) + +(ert-deftest cperl-test-unicode-sub () + (with-temp-buffer + (cperl--test-unicode-setup + (concat "use strict;\n" ; distinguish bob from b-o-f + "sub ℏ {\n" + " 6.62607015e-34\n" + "};") + "sub ") ; point is before "ℏ" + + ;; Testing fontification + ;; FIXME 2021-09-10: This tests succeeds because cperl-mode + ;; accepts almost anything as a sub name for fontification. For + ;; example, it fontifies "sub @ {...;}" which is a syntax error in + ;; Perl. I let this pass for the moment. + (should (equal (get-text-property (point) 'face) + 'font-lock-function-name-face)) + + ;; Testing `beginning-of-defun'. Not available in perl-mode, + ;; where it jumps to the beginning of the buffer. + (when (eq cperl-test-mode #'cperl-mode) + (goto-char (point-min)) + (search-forward "-34") + (beginning-of-defun) + (should (looking-at "sub"))))) + +(ert-deftest cperl-test-unicode-varname () + (with-temp-buffer + (cperl--test-unicode-setup + (concat "use strict;\n" + "my $π = 3.1415926535897932384626433832795028841971;\n" + "\n" + "my $manĝi = $π;\n" + "__END__\n") + "my $") ; perl-mode doesn't fontify the sigil, so include it here + + ;; Testing fontification + ;; FIXME 2021-09-10: This test succeeds in cperl-mode because the + ;; π character is "not ASCII alphabetic", so it treats $π as a + ;; punctuation variable. The following two `should' forms with a + ;; longer variable name were added for stronger verification. + (should (equal (get-text-property (point) 'face) + 'font-lock-variable-name-face)) + ;; Test both ends of a longer variable name + (search-forward "my $") ; again skip the sigil + (should (equal (get-text-property (point) 'face) + 'font-lock-variable-name-face)) + (search-forward "manĝi") + (should (equal (get-text-property (1- (match-end 0)) 'face) + 'font-lock-variable-name-face)))) + +(ert-deftest cperl-test-unicode-varname-list () + "Verify that all elements of a variable list are fontified." + + (let ((hash-face (if (eq cperl-test-mode #'perl-mode) + 'perl-non-scalar-variable + 'cperl-hash-face)) + (array-face (if (eq cperl-test-mode #'perl-mode) + 'perl-non-scalar-variable + 'cperl-array-face))) + (with-temp-buffer + (cperl--test-unicode-setup + "my (%äsh,@ärräy,$scâlâr);" "%") + (should (equal (get-text-property (point) 'face) + hash-face)) + (search-forward "@") + (should (equal (get-text-property (point) 'face) + array-face)) + (search-forward "scâlâr") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-variable-name-face)) + (should (equal (get-text-property (1- (match-end 0)) 'face) + 'font-lock-variable-name-face))) + + ;; Now with package-qualified variables + (with-temp-buffer + (cperl--test-unicode-setup + "local (%Søme::äsh,@Søme::ärräy,$Søme::scâlâr);" "%") + (should (equal (get-text-property (point) 'face) + hash-face)) + (search-forward "Søme::") ; test basic identifier + (should (equal (get-text-property (point) 'face) + hash-face)) + (search-forward "@") ; test package name + (should (equal (get-text-property (point) 'face) + array-face)) + (search-forward "Søme::") ; test basic identifier + (should (equal (get-text-property (point) 'face) + array-face)) + (search-forward "Søme") ; test package name + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-variable-name-face)) + (should (equal (get-text-property (1- (match-end 0)) 'face) + 'font-lock-variable-name-face)) + (search-forward "scâlâr") ; test basic identifier + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-variable-name-face)) + (should (equal (get-text-property (1- (match-end 0)) 'face) + 'font-lock-variable-name-face))))) + +(ert-deftest cperl-test-unicode-arrays () + "Test fontification of array access." + ;; Perl mode just looks at the sigil, for element access + (skip-unless (eq cperl-test-mode #'cperl-mode)) + ;; simple array element + (with-temp-buffer + (cperl--test-unicode-setup + "$ärräy[1] = 7;" "$") + (should (equal (get-text-property (point) 'face) + 'cperl-array-face))) + ;; array slice + (with-temp-buffer + (cperl--test-unicode-setup + "@ärräy[(1..3)] = (4..6);" "@") + (should (equal (get-text-property (point) 'face) + 'cperl-array-face))) + ;; array max index + (with-temp-buffer + (cperl--test-unicode-setup + "$#ärräy = 1;" "$") + (should (equal (get-text-property (point) 'face) + 'cperl-array-face))) + ;; array dereference + (with-temp-buffer + (cperl--test-unicode-setup + "@$ärräy = (1,2,3)" "@") + (should (equal (get-text-property (1- (point)) 'face) + 'cperl-array-face)) + (should (equal (get-text-property (1+ (point)) 'face) + 'font-lock-variable-name-face)))) + +(ert-deftest cperl-test-unicode-hashes () + "Test fontification of hash access." + ;; Perl mode just looks at the sigil, for element access + (skip-unless (eq cperl-test-mode #'cperl-mode)) + ;; simple hash element + (with-temp-buffer + (cperl--test-unicode-setup + "$häsh{'a'} = 7;" "$") + (should (equal (get-text-property (point) 'face) + 'cperl-hash-face))) + ;; hash array slice + (with-temp-buffer + (cperl--test-unicode-setup + "@häsh{(1..3)} = (4..6);" "@") + (should (equal (get-text-property (point) 'face) + 'cperl-hash-face))) + ;; hash subset + (with-temp-buffer + (cperl--test-unicode-setup + "my %hash = %häsh{'a',2,3};" "= %") + (should (equal (get-text-property (point) 'face) + 'cperl-hash-face))) + ;; hash dereference + (with-temp-buffer + (cperl--test-unicode-setup + "%$äsh = (key => 'value');" "%") + (should (equal (get-text-property (1- (point)) 'face) + 'cperl-hash-face)) + (should (equal (get-text-property (1+ (point)) 'face) + 'font-lock-variable-name-face)))) + +(ert-deftest cperl-test-unicode-hashref () + "Verify that a hashref access disambiguates {s}. +CPerl mode takes the token \"s\" as a substitution unless +detected otherwise. Not for perl-mode: it doesn't stringify +bareword hash keys and doesn't recognize a substitution +\"s}foo}bar}\"" + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (with-temp-buffer + (cperl--test-unicode-setup "$häshref->{s} # }}" "{") + (should (equal (get-text-property (point) 'face) + 'font-lock-string-face)) + (should (equal (get-text-property (1+ (point)) 'face) + nil)))) + +(ert-deftest cperl-test-unicode-proto () + ;; perl-mode doesn't fontify prototypes at all + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (with-temp-buffer + (cperl--test-unicode-setup + (concat "sub prötötyped ($) {\n" + " ...;" + "}\n") + "prötötyped (") + + (should (equal (get-text-property (point) 'face) + 'font-lock-string-face)))) + +(ert-deftest cperl-test-unicode-fhs () + (with-temp-buffer + (cperl--test-unicode-setup + (concat "while () {\n" + " ...;)\n" + "}\n") + "while (<") ; point is before the first char of the handle + ;; Testing fontification + ;; FIXME 2021-09-10: perl-mode.el and cperl-mode.el handle these + ;; completely differently. perl-mode interprets barewords as + ;; constants, cperl-mode does not fontify them. Both treat + ;; non-barewords as globs, which are not fontified by perl-mode, + ;; but fontified as strings in cperl-mode. We keep (and test) + ;; that behavior "as is" because both bareword filehandles and + ;; syntax are no longer recommended. + (let ((bareword-face + (if (equal cperl-test-mode 'perl-mode) 'font-lock-constant-face + nil))) + (should (equal (get-text-property (point) 'face) + bareword-face))))) + +(ert-deftest cperl-test-unicode-hashkeys () + "Test stringification of bareword hash keys. Not in perl-mode. +perl-mode generally does not stringify bareword hash keys." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + ;; Plain hash key + (with-temp-buffer + (cperl--test-unicode-setup + "$häsh { kéy }" "{ ") + (should (equal (get-text-property (point) 'face) + 'font-lock-string-face))) + ;; Nested hash key + (with-temp-buffer + (cperl--test-unicode-setup + "$häsh { kéy } { kèy }" "} { ") + (should (equal (get-text-property (point) 'face) + 'font-lock-string-face))) + ;; Key => value + (with-temp-buffer + (cperl--test-unicode-setup + "( kéy => 'value'," "( ") + (should (equal (get-text-property (point) 'face) + 'font-lock-string-face)))) + +(ert-deftest cperl-test-word-at-point () + "Test whether the function captures non-ASCII words." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((words '("rôle" "café" "ångström" + "Data::Dump::dump" + "_underscore"))) + (dolist (word words) + (with-temp-buffer + (insert " + ") ; this will be the suffix + (beginning-of-line) + (insert ")") ; A non-word char + (insert word) + (should (string= word (cperl-word-at-point-hard))))))) + ;;; Function test: Building an index for imenu (ert-deftest cperl-test-imenu-index () @@ -369,7 +667,8 @@ created by CPerl mode, so skip it for Perl mode." "Versioned::Package::outer" "lexical" "Versioned::Block::signatured" - "Package::in_package_again"))) + "Package::in_package_again" + "Erdős::Number::erdős_number"))) (dolist (sub expected) (should (assoc-string sub index))))))) -- cgit v1.2.3 From c882b4ea02b705d866fbcdd886b577b9592479fe Mon Sep 17 00:00:00 2001 From: Harald Jörg Date: Wed, 2 Feb 2022 22:30:09 +0100 Subject: ; 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 --- lisp/progmodes/cperl-mode.el | 2 +- .../cperl-mode-resources/proto-and-attrs.pl | 50 ++++++++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 49 +++++++++++++++++++++ 3 files changed, 100 insertions(+), 1 deletion(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 8f33b3e3b73..94ecc45b15f 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3834,7 +3834,7 @@ recursive calls in starting lines of here-documents." "\\<" cperl-sub-regexp "\\>" ; sub with proto/attr "\\(" cperl-white-and-comment-rex - (rx (group (eval cperl--normal-identifier-rx))) + (rx (opt (group (eval cperl--normal-identifier-rx)))) "\\)" "\\(" cperl-maybe-white-and-comment-rex 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 "\\_ Date: Fri, 16 Sep 2022 13:05:54 +0200 Subject: Fix cperl list indentation problem * lisp/progmodes/cperl-mode.el (cperl-calculate-indent): Indent foo:bar() in lists correctly (bug#57829). --- lisp/progmodes/cperl-mode.el | 2 +- .../cperl-mode-resources/cperl-indents.erts | 26 ++++++++++++++++++++++ test/lisp/progmodes/cperl-mode-tests.el | 3 +++ 3 files changed, 30 insertions(+), 1 deletion(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index a3995e2969d..85229250ee0 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3016,7 +3016,7 @@ and closing parentheses and brackets." ;; Now it is a hash reference (+ cperl-indent-level cperl-close-paren-offset)) ;; Labels do not take :: ... - (if (looking-at "\\(\\w\\|_\\)+[ \t]*:") + (if (looking-at "\\(\\w\\|_\\)+[ \t]*:[^:]") (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) ;; Do not move `parse-data', this should diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts new file mode 100644 index 00000000000..6b874ffaa1f --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts @@ -0,0 +1,26 @@ +Code: + (lambda () + (cperl-mode) + (indent-region (point-min) (point-max))) + +Name: cperl-indent1 + +=-= +{ + print "", + "", + foo::bar(), + ""; +} +=-=-= + +Name: cperl-indents1 + +=-= +{ + print "", + "", + foobar(), + ""; +} +=-=-= diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 7eb2d9be756..db3feec93ab 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1103,4 +1103,7 @@ as a regex." (funcall cperl-test-mode) (should-not (nth 3 (syntax-ppss 3))))) +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) + ;;; cperl-mode-tests.el ends here -- cgit v1.2.3 From 1231a601ebe1fd9fe454c504dbeb9267440242e7 Mon Sep 17 00:00:00 2001 From: Mauro Aranda Date: Tue, 20 Sep 2022 11:18:45 -0300 Subject: Recognize the backslash operator in perl-mode * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Add new rule to detect a backslash operator. (Bug#11996) * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-11996): New test. * test/lisp/progmodes/cperl-mode-resources/cperl-bug-11996.pl: New file. --- lisp/progmodes/perl-mode.el | 6 +++++ .../cperl-mode-resources/cperl-bug-11996.pl | 8 ++++++ test/lisp/progmodes/cperl-mode-tests.el | 30 ++++++++++++++++++++++ 3 files changed, 44 insertions(+) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-bug-11996.pl (limited to 'test/lisp/progmodes/cperl-mode-resources') diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index bd8f4ecd1c0..7b7a2cdf019 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -242,6 +242,12 @@ (not (nth 3 (syntax-ppss (match-beginning 0)))))) (string-to-syntax ". p")))) + ;; If "\" is acting as a backslash operator, it shouldn't start an + ;; escape sequence, so change its syntax. This allows us to handle + ;; correctly the \() construct (Bug#11996) as well as references + ;; to string values. + ("\\(\\\\\\)['`\"($]" (1 (unless (nth 3 (syntax-ppss)) + (string-to-syntax ".")))) ;; Handle funny names like $DB'stop. ("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) ;; format statements diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11996.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11996.pl new file mode 100644 index 00000000000..566b7e7550f --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11996.pl @@ -0,0 +1,8 @@ +{ + my @zzzz=(\%seen_couchrequsts, \%seen_people ); + my @zzzz=\(%seen_couchrequsts, %seen_people ); + my @zzzz=(\%seen_couchrequsts, \%seen_people ); +} + +print "\"Watch out\""; +$ref = \"howdy"; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 66039d6fc7f..1bb206e7040 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -788,6 +788,36 @@ under timeout control." (should (string-match "poop ('foo', \n 'bar')" (buffer-string)))))) +(ert-deftest cperl-test-bug-11996 () + "Verify that we give the right syntax property to a backslash operator." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-11996.pl")) + (funcall cperl-test-mode) + (font-lock-ensure) + (goto-char (point-min)) + (re-search-forward "\\(\\\\(\\)") + (save-excursion + (goto-char (match-beginning 1)) + (should (equal (syntax-after (point)) (string-to-syntax "."))) + ;; `forward-sexp' shouldn't complain. + (forward-sexp) + (should (char-equal (char-after) ?\;))) + (re-search-forward "\\(\\\\\"\\)") + (save-excursion + (goto-char (match-beginning 1)) + (should (equal (syntax-after (point)) (string-to-syntax "\\"))) + (should (equal (get-text-property (point) 'face) 'font-lock-string-face))) + (re-search-forward "\\(\\\\\"\\)") + (save-excursion + (goto-char (match-beginning 1)) + (should (equal (syntax-after (point)) (string-to-syntax "\\")))) + (re-search-forward "\\(\\\\\"\\)") + (save-excursion + (goto-char (match-beginning 1)) + (should (equal (syntax-after (point)) (string-to-syntax "."))) + (should (equal (get-text-property (1+ (point)) 'face) + 'font-lock-string-face))))) + (ert-deftest cperl-test-bug-14343 () "Verify that inserting text into a HERE-doc string with Elisp does not break fontification." -- cgit v1.2.3