diff options
Diffstat (limited to 'test/lisp/progmodes/cperl-mode-tests.el')
| -rw-r--r-- | test/lisp/progmodes/cperl-mode-tests.el | 260 |
1 files changed, 254 insertions, 6 deletions
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 943c454445c..4d2bac6ee47 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1,4 +1,4 @@ -;;; cperl-mode-tests --- Test for cperl-mode -*- lexical-binding: t -*- +;;; cperl-mode-tests.el --- Test for cperl-mode -*- lexical-binding: t -*- ;; Copyright (C) 2020-2021 Free Software Foundation, Inc. @@ -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) @@ -135,6 +135,28 @@ 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-test-fontify-declarations () + "Test that declarations and package usage use consistent fontification." + (with-temp-buffer + (funcall cperl-test-mode) + (insert "package Foo::Bar;\n") + (insert "use Fee::Fie::Foe::Foo\n;") + (insert "my $xyzzy = 'PLUGH';\n") + (goto-char (point-min)) + (font-lock-ensure) + (search-forward "Bar") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-function-name-face)) + (search-forward "use") ; This was buggy in perl-mode + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-keyword-face)) + (search-forward "my") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-keyword-face)))) + +(defvar perl-continued-statement-offset) +(defvar perl-indent-level) + (ert-deftest cperl-test-heredocs () "Test that HERE-docs are fontified with the appropriate face." (require 'perl-mode) @@ -166,6 +188,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-contents (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 () @@ -260,6 +377,55 @@ 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." + (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-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 @@ -331,14 +497,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 } # /")) @@ -352,4 +518,86 @@ have a face property." ;; The yadda-yadda operator should not be in a string. (should (equal (nth 8 (cperl-test-ppss code "\\.")) nil)))) +(ert-deftest cperl-test-bug-47112 () + "Check that in a bareword starting with a quote-like operator +followed by an underscore is not interpreted as that quote-like +operator. Also check that a quote-like operator followed by a +colon (which is, like ?_, a symbol in CPerl mode) _is_ identified +as that quote like operator." + (with-temp-buffer + (funcall cperl-test-mode) + (insert "sub y_max { q:bar:; y _bar_foo_; }") + (goto-char (point-min)) + (syntax-propertize (point-max)) + (font-lock-ensure) + (search-forward "max") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-function-name-face)) + (search-forward "bar") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-string-face)) + ; perl-mode doesn't highlight + (when (eq cperl-test-mode #'cperl-mode) + (search-forward "_") + (should (equal (get-text-property (match-beginning 0) 'face) + (if (eq cperl-test-mode #'cperl-mode) + 'font-lock-constant-face + font-lock-string-face)))))) + +(ert-deftest cperl-test-hyperactive-electric-else () + "Demonstrate cperl-electric-else behavior. +If `cperl-electric-keywords' is true, keywords like \"else\" and +\"continue\" are expanded by a following empty block, with the +cursor in the appropriate position to write that block. This, +however, must not happen when the keyword occurs in a variable +\"$else\" or \"$continue\"." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + ;; `self-insert-command' takes a second argument only since Emacs 27 + (skip-unless (not (< emacs-major-version 27))) + (with-temp-buffer + (setq cperl-electric-keywords t) + (cperl-mode) + (insert "continue") + (self-insert-command 1 ?\ ) + (indent-region (point-min) (point-max)) + (goto-char (point-min)) + ;; cperl-mode creates a block here + (should (search-forward-regexp "continue {\n[[:blank:]]+\n}"))) + (with-temp-buffer + (setq cperl-electric-keywords t) + (cperl-mode) + (insert "$continue") + (self-insert-command 1 ?\ ) + (indent-region (point-min) (point-max)) + (goto-char (point-min)) + ;; No block should have been created here + (should-not (search-forward-regexp "{" nil t)))) + +(ert-deftest cperl-test-bug-47598 () + "Check that a file test followed by ? is no longer interpreted +as a regex." + ;; Testing the text from the bug report + (with-temp-buffer + (insert "my $f = -f ? 'file'\n") + (insert " : -l ? [readlink]\n") + (insert " : -d ? 'dir'\n") + (insert " : 'unknown';\n") + (funcall cperl-test-mode) + ;; Perl mode doesn't highlight file tests as functions, so we + ;; can't test for the function's face. But we can verify that the + ;; function is not a string. + (goto-char (point-min)) + (search-forward "?") + (should-not (nth 3 (syntax-ppss (point))))) + ;; Testing the actual targets for the regexp: m?foo? (still valid) + ;; and ?foo? (invalid since Perl 5.22) + (with-temp-buffer + (insert "m?foo?;") + (funcall cperl-test-mode) + (should (nth 3 (syntax-ppss 3)))) + (with-temp-buffer + (insert " ?foo?;") + (funcall cperl-test-mode) + (should-not (nth 3 (syntax-ppss 3))))) + ;;; cperl-mode-tests.el ends here |