diff options
Diffstat (limited to 'test/lisp/progmodes')
22 files changed, 1665 insertions, 191 deletions
diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el new file mode 100644 index 00000000000..7a3ab5fbda0 --- /dev/null +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -0,0 +1,128 @@ +;;; bug-reference-tests.el --- Tests for bug-reference.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'bug-reference) +(require 'ert) + +(defun test--get-github-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "github.com" 'github "https")) + url) + (match-string 1 url))) + +(defun test--get-gitlab-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "gitlab.com" 'gitlab "https")) + url) + (match-string 1 url))) + +(defun test--get-gitea-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "gitea.com" 'gitea "https")) + url) + (match-string 1 url))) + +(ert-deftest test-github-entry () + (should + (equal + (test--get-github-entry "git@github.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-github-entry "git@github.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-github-entry "https://github.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-github-entry "https://github.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-github-entry "https://github.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-github-entry "https://github.com/magit/magit/") + "magit/magit"))) + +(ert-deftest test-gitlab-entry () + (should + (equal + (test--get-gitlab-entry "git@gitlab.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-gitlab-entry "git@gitlab.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit/") + "magit/magit"))) + +(ert-deftest test-gitea-entry () + (should + (equal + (test--get-gitea-entry "git@gitea.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-gitea-entry "git@gitea.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit/") + "magit/magit"))) + +;;; bug-reference-tests.el ends here 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-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/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 4d2bac6ee47..29b9e3f6fb9 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -154,16 +154,122 @@ 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 + appropriate." + (let ((here-docs + '("$text .= <<DELIM;" ; mutator concatenating a here-doc + "func($arg) . <<DELIM;" ; concatenating a return value + "func 1, <<DELIM;" ; a function taking two arguments + )) + ;; There forms are currently mishandled in `perl-mode' :-( + (here-docs-cperl + '("print {a} <<DELIM;" ; printing to a file handle + "system $prog <<DELIM;" ; lie about the program's name + )) + (_undecidable + '("foo <<bar") ; could be either "foo() <<bar" + ; or "foo(<<bar)" + )) + (dolist (code (append here-docs (if (eq cperl-test-mode #'cperl-mode) + here-docs-cperl))) + (with-temp-buffer + (insert code "\n\nDELIM\n") + (funcall cperl-test-mode) + (goto-char (point-min)) + (forward-line 1) + ;; We should now be within a here-doc. + (let ((ppss (syntax-ppss))) + (should (and (nth 8 ppss) (nth 4 ppss)))) + )))) + +(ert-deftest cperl-test-identify-no-heredoc () + "Test whether a construct containing \"<<\" which is not a + here-document is properly rejected." + (let ( + (not-here-docs + '("while (<<>>) {" ; double angle bracket operator + "expr <<func();" ; left shift by a return value + "$var <<func;" ; left shift by a return value + "($var+1) <<func;" ; same for an expression + "$hash{key} <<func;" ; same for a hash element + "or $var <<func;" ; same for an expression + "sorted $by <<func" ; _not_ a call to sort + )) + (_undecidable + '("foo <<bar" ; could be either "foo() <<bar" + ; or "foo(<<bar)" + "$foo = <<;") ; empty delim forbidden since 5.28 + )) + (dolist (code not-here-docs) + (with-temp-buffer + (insert code "\n\n") + (funcall cperl-test-mode) + (goto-char (point-min)) + (forward-line 1) + ;; Point is not within a here-doc (nor string nor comment). + (let ((ppss (syntax-ppss))) + (should-not (nth 8 ppss))) + )))) + +(ert-deftest cperl-test-here-doc-missing-end () + "Verify that a missing here-document terminator gives a message. +This message prints the terminator which wasn't found and is only +issued by CPerl mode." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (ert-with-message-capture collected-messages + (with-temp-buffer + (insert "my $foo = <<HERE\n") + (insert "some text here\n") + (goto-char (point-min)) + (funcall cperl-test-mode) + (cperl-find-pods-heres) + (should (string-match "End of here-document [‘'`]HERE[’']" + collected-messages)))) + (ert-with-message-capture collected-messages + (with-temp-buffer + (insert "my $foo = <<HERE . <<'THERE'\n") + (insert "some text here\n") + (insert "HERE\n") + (insert "more text here\n") + (goto-char (point-min)) + (funcall cperl-test-mode) + (cperl-find-pods-heres) + (should (string-match "End of here-document [‘'`]THERE[’']" + collected-messages))))) + (defvar perl-continued-statement-offset) (defvar perl-indent-level) +(defconst cperl--tests-heredoc-face + (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc + 'font-lock-string-face)) +(defconst cperl--tests-heredoc-delim-face + (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc + 'font-lock-constant-face)) + (ert-deftest cperl-test-heredocs () "Test that HERE-docs are fontified with the appropriate face." (require 'perl-mode) (let ((file (ert-resource-file "here-docs.pl")) (cperl-continued-statement-offset perl-continued-statement-offset) - (target-font (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc - 'font-lock-string-face)) (case-fold-search nil)) (with-temp-buffer (insert-file-contents file) @@ -176,7 +282,7 @@ point in the distant past, and is still broken in perl-mode. " (while (search-forward "look-here" nil t) (should (equal (get-text-property (match-beginning 0) 'face) - target-font)) + cperl--tests-heredoc-face)) (beginning-of-line) (should (null (looking-at "[ \t]"))) (forward-line 1))) @@ -205,27 +311,30 @@ the whole string." (and (string-match regexp string) (string= (match-string 0 string) string)))))) -(ert-deftest cperl-test-ws-regexp () +(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 '("a" " " ""))) - (cperl-test--validate-regexp cperl--ws-regexp + (cperl-test--validate-regexp (rx (eval cperl--ws-rx)) valid invalid))) -(ert-deftest cperl-test-ws-or-comment-regexp () +(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"))) (invalid '("=head1 NAME\n" ))) - (cperl-test--validate-regexp cperl--ws-or-comment-regexp + (cperl-test--validate-regexp (rx (eval cperl--ws+-rx)) valid invalid))) (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")) @@ -241,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" @@ -253,9 +363,287 @@ Also includes valid cases with whitespace in strange places." "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 + (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 (<BAREWÖRD>) {\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 + ;; <glob> 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 () @@ -279,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))))))) @@ -339,6 +728,72 @@ under timeout control." (should (string-match "poop ('foo', \n 'bar')" (buffer-string)))))) +(ert-deftest cperl-test-bug-14343 () + "Verify that inserting text into a HERE-doc string with Elisp +does not break fontification." + (with-temp-buffer + (insert "my $string = <<HERE;\n" + "One line of text.\n" + "Last line of this string.\n" + "HERE\n") + (funcall cperl-test-mode) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "One line") + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-face)) + (beginning-of-line) + (insert "Another line if text.\n") + (font-lock-ensure) + (forward-line -1) + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-face)) + (search-forward "HERE") + (beginning-of-line) + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-delim-face))) + ;; insert into an empty here-document + (with-temp-buffer + (insert "print <<HERE;\n" + "HERE\n") + (funcall cperl-test-mode) + (font-lock-ensure) + (goto-char (point-min)) + (forward-line) + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-delim-face)) + ;; Insert a newline into the empty here-document + (goto-char (point-min)) + (forward-line) + (insert "\n") + (search-forward "HERE") + (beginning-of-line) + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-delim-face)) + ;; Insert text at the beginning of the here-doc + (goto-char (point-min)) + (forward-line) + (insert "text") + (font-lock-ensure) + (search-backward "text") + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-face)) + (search-forward "HERE") + (beginning-of-line) + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-delim-face)) + ;; Insert a new line immediately before the delimiter + ;; (That's where the point is anyway) + (insert "A new line\n") + (font-lock-ensure) + ;; The delimiter is still the delimiter + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-delim-face)) + (forward-line -1) + ;; The new line has been "added" to the here-document + (should (equal (get-text-property (point) 'face) + cperl--tests-heredoc-face)))) + (ert-deftest cperl-test-bug-16368 () "Verify that `cperl-forward-group-in-re' doesn't hide errors." (skip-unless (eq cperl-test-mode #'cperl-mode)) diff --git a/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts new file mode 100644 index 00000000000..2c0d51edae8 --- /dev/null +++ b/test/lisp/progmodes/elisp-mode-resources/elisp-indents.erts @@ -0,0 +1,88 @@ +Code: + (lambda () + (emacs-lisp-mode) + (indent-region (point-min) (point-max))) + +Name: defun + +=-= +(defun foo () +"doc" +(+ 1 2)) +=-= +(defun foo () + "doc" + (+ 1 2)) +=-=-= + +Name: function call + +=-= +(foo zot +bar +(zot bar)) +=-= +(foo zot + bar + (zot bar)) +=-=-= + +Name: lisp data + +=-= +( foo zot +bar +(zot bar)) +=-= +( foo zot + bar + (zot bar)) +=-=-= + +Name: defun-space + +=-= +(defun x () + (print (quote ( thingy great + stuff))) + (print (quote (thingy great + stuff)))) +=-=-= + +Name: defvar-keymap + +=-= +(defvar-keymap eww-link-keymap + :copy shr-map + :foo bar + "\r" #'eww-follow-link) +=-=-= + +Name: def-indent1 + +=-= +(defzot-does-not-exist 1 + 2 3) +=-=-= + +Name: def-indent2 + +=-= +(define-keymap 1 + 2 3) +=-=-= + +Name: elisp-indents1 + +=-= +(defvar foo + () + "bar") +=-=-= + +Name: elisp-indents2 + +=-= +(defvar foo () + "bar") +=-=-= diff --git a/test/lisp/progmodes/elisp-mode-resources/flet.erts b/test/lisp/progmodes/elisp-mode-resources/flet.erts new file mode 100644 index 00000000000..da3dcb6ec3e --- /dev/null +++ b/test/lisp/progmodes/elisp-mode-resources/flet.erts @@ -0,0 +1,353 @@ +Name: flet1 + +=-= +(cl-flet () + (a (dangerous-position + b))) +=-=-= + +Name: flet2 + +=-= +(cl-flet wrong-syntax-but-should-not-obstruct-indentation + (a (dangerous-position + b))) +=-=-= + +Name: flet3 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c))) +=-=-= + +Name: flet4 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet5 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet6 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + (irregular-local-def (form returning + lambda)) + wrong-syntax-but-should-not-osbtruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet7 + +=-= +(cl-flet ((a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + wrong-syntax-but-should-not-osbtruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet8 + +=-= +(cl-flet (wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +;; (setf _) not yet supported but looks like it will be +Name: flet9 + +=-= +(cl-flet (((setf a) (new value) + stuff) + wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet10 + +=-= +(cl-flet ( (a (arg-of-flet-a) + b + c + (if d + e + f)) + (irregular-local-def (form + returning + lambda)) + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet11 + +=-= +(cl-flet ( wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet12 + +=-= +(cl-flet ( wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i)) + (let ((j k)) + (if dangerous-position + l + m))) +=-=-= + +Name: flet13 + +=-= +(cl-flet (wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i) + wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i))) +=-=-= + +Name: flet14 + +=-= +(cl-flet (wrong-syntax-but-should-not-obstruct-indentation + wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i) + wrong-syntax-but-should-not-obstruct-indentation)) +=-=-= + +Name: flet15 + +=-= +(cl-flet (wrong-syntax-but-should-not-obstruct-indentation + wrong-syntax-but-should-not-obstruct-indentation + wrong-syntax-but-should-not-obstruct-indentation + (g (arg-of--flet-g) + h + i))) +=-=-= + +Name: flet16 + +=-= +(cl-flet ((f (x) + (g x))) + (pcase e + ((dangerous-expression) + (form)))) +=-=-= + +Name: flet-indentation-incomplete-sexp-no-side-effects-1 +Code: (lambda () (emacs-lisp-mode) (setq indent-tabs-mode nil) (newline nil t)) +Point-Char: | + +=-= +(let ((x (and y| +=-= +(let ((x (and y + | +=-=-= + +Name: flet-indentation-incomplete-sexp-no-side-effects-2 + +=-= +(let ((x| +=-= +(let ((x + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-1 +Point-Char: | + +=-= +(cl-flet((f (x)| +=-= +(cl-flet((f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-2 +Point-Char: | + +=-= +(cl-flet((f(x)| +=-= +(cl-flet((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-3 + +=-= +(cl-flet ((f(x)| +=-= +(cl-flet ((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-4 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-5 + +=-= +(cl-flet( (f(x)| +=-= +(cl-flet( (f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-1 + +=-= +(cl-flet((f (x)| +=-= +(cl-flet((f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-2 + +=-= +(cl-flet ((f(x)| +=-= +(cl-flet ((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-3 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-4 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-5 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-6 + +=-= +(cl-flet( (f(x)| +=-= +(cl-flet( (f(x) + | +=-=-= diff --git a/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el b/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el new file mode 100644 index 00000000000..9b41fb5426c --- /dev/null +++ b/test/lisp/progmodes/elisp-mode-resources/simple-shorthand-test.el @@ -0,0 +1,40 @@ +;;; simple-shorthand-test.el --- -*- lexical-binding: t; -*- + +(defun f-test () + (let ((read-symbol-shorthands '(("foo-" . "bar-")))) + (with-temp-buffer + (insert "(foo-bar)") + (goto-char (point-min)) + (read (current-buffer))))) + +(defun f-test2 () + (let ((read-symbol-shorthands '(("foo-" . "bar-")))) + (read-from-string "(foo-bar)"))) + + +(defun f-test3 () + (let ((read-symbol-shorthands '(("foo-" . "bar-")))) + (intern "foo-bar"))) + +(defvar f-test-complete-me 42) + +(elisp--foo-test3) + +(defun #_f-test4--- () 84) + +(defmacro f-define-test-5 ()) + +;; should be font locked with both shorthand +;; highlighting _and_ macro highlighting. +(f-define-test-5) + +(when nil + (f-test3) + (f-test2) + (f-test) + (#_f-test4---)) + + +;; Local Variables: +;; read-symbol-shorthands: (("f-" . "elisp--foo-")) +;; End: diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index f47d54e59c0..7f1cd6795ef 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -23,8 +23,10 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'xref) (eval-when-compile (require 'cl-lib)) +(require 'ert-x) ;;; Completion @@ -300,12 +302,9 @@ ;; tmp may be on a different filesystem to the tests, but, ehh. (defvar xref--case-insensitive - (let ((dir (make-temp-file "xref-test" t))) - (unwind-protect - (progn - (with-temp-file (expand-file-name "hElLo" dir) "hello") - (file-exists-p (expand-file-name "HELLO" dir))) - (delete-directory dir t))) + (ert-with-temp-directory dir + (with-temp-file (expand-file-name "hElLo" dir) "hello") + (file-exists-p (expand-file-name "HELLO" dir))) "Non-nil if file system seems to be case-insensitive.") (defun xref-elisp-test-run (xrefs expected-xrefs) @@ -315,27 +314,27 @@ (expected (pop expected-xrefs)) (expected-xref (or (when (consp expected) (car expected)) expected)) (expected-source (when (consp expected) (cdr expected))) - (xref-file (xref-elisp-location-file (oref xref location))) + (xref-file (xref-elisp-location-file (xref-item-location xref))) (expected-file (xref-elisp-location-file - (oref expected-xref location)))) + (xref-item-location expected-xref)))) ;; Make sure file names compare as strings. (when (file-name-absolute-p xref-file) - (setf (xref-elisp-location-file (oref xref location)) - (file-truename (xref-elisp-location-file (oref xref location))))) + (setf (xref-elisp-location-file (xref-item-location xref)) + (file-truename (xref-elisp-location-file (xref-item-location xref))))) (when (file-name-absolute-p expected-file) - (setf (xref-elisp-location-file (oref expected-xref location)) + (setf (xref-elisp-location-file (xref-item-location expected-xref)) (file-truename (xref-elisp-location-file - (oref expected-xref location))))) + (xref-item-location expected-xref))))) ;; Downcase the filenames for case-insensitive file systems. (when xref--case-insensitive - (setf (xref-elisp-location-file (oref xref location)) - (downcase (xref-elisp-location-file (oref xref location)))) + (setf (xref-elisp-location-file (xref-item-location xref)) + (downcase (xref-elisp-location-file (xref-item-location xref)))) - (setf (xref-elisp-location-file (oref expected-xref location)) + (setf (xref-elisp-location-file (xref-item-location expected-xref)) (downcase (xref-elisp-location-file - (oref expected-xref location))))) + (xref-item-location expected-xref))))) (should (equal xref expected-xref)) @@ -416,8 +415,6 @@ to (xref-elisp-test-descr-to-target xref)." ;; FIXME: defconst -;; FIXME: eieio defclass - ;; Possible ways of defining the default method implementation for a ;; generic function. We declare these here, so we know we cover all ;; cases, and we don't rely on other code not changing. @@ -429,7 +426,7 @@ to (xref-elisp-test-descr-to-target xref)." slot-1) (cl-defgeneric xref-elisp-generic-no-methods (arg1 arg2) - "doc string generic no-methods" + "Doc string generic no-methods." ;; No default implementation, no methods, but fboundp is true for ;; this symbol; it calls cl-no-applicable-method ) @@ -440,44 +437,44 @@ to (xref-elisp-test-descr-to-target xref)." ;; ‘this’. It passes in interactive tests, so I haven't been able to ;; track down the problem. (cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type) arg2) - "doc string generic no-default xref-elisp-root-type" + "Doc string generic no-default xref-elisp-root-type." "non-default for no-default") ;; defgeneric after defmethod in file to ensure the fallback search ;; method of just looking for the function name will fail. (cl-defgeneric xref-elisp-generic-no-default (arg1 arg2) - "doc string generic no-default generic" + "Doc string generic no-default generic." ;; No default implementation; this function calls the cl-generic ;; dispatching code. ) (cl-defgeneric xref-elisp-generic-co-located-default (arg1 arg2) - "doc string generic co-located-default" + "Doc string generic co-located-default." "co-located default") (cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type) arg2) - "doc string generic co-located-default xref-elisp-root-type" + "Doc string generic co-located-default xref-elisp-root-type." "non-default for co-located-default") (cl-defgeneric xref-elisp-generic-separate-default (arg1 arg2) - "doc string generic separate-default" + "Doc string generic separate-default." ;; default implementation provided separately ) (cl-defmethod xref-elisp-generic-separate-default (arg1 arg2) - "doc string generic separate-default default" + "Doc string generic separate-default default." "separate default") (cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type) arg2) - "doc string generic separate-default xref-elisp-root-type" + "Doc string generic separate-default xref-elisp-root-type." "non-default for separate-default") (cl-defmethod xref-elisp-generic-implicit-generic (arg1 arg2) - "doc string generic implicit-generic default" + "Doc string generic implicit-generic default." "default for implicit generic") (cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type) arg2) - "doc string generic implicit-generic xref-elisp-root-type" + "Doc string generic implicit-generic xref-elisp-root-type." "non-default for implicit generic") @@ -604,6 +601,12 @@ to (xref-elisp-test-descr-to-target xref)." 'xref-location-marker nil '(xref-etags-location)) 'cl-defmethod (expand-file-name "../../../lisp/progmodes/etags.el" emacs-test-dir))) + (xref-make "(cl-defmethod xref-location-marker ((l xref-etags-apropos-location)))" + (xref-make-elisp-location + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-etags-apropos-location)) + 'cl-defmethod + (expand-file-name "../../../lisp/progmodes/etags.el" emacs-test-dir))) )) (xref-elisp-deftest find-defs-defgeneric-eval @@ -617,35 +620,35 @@ to (xref-elisp-test-descr-to-target xref)." (declare-function xref-elisp-overloadable-no-default-default "elisp-mode-tests") (define-overloadable-function xref-elisp-overloadable-no-methods () - "doc string overloadable no-methods") + "Doc string overloadable no-methods.") (define-overloadable-function xref-elisp-overloadable-no-default () - "doc string overloadable no-default") + "Doc string overloadable no-default.") (define-mode-local-override xref-elisp-overloadable-no-default c-mode (_start _end &optional _nonterminal _depth _returnonerror) - "doc string overloadable no-default c-mode." + "Doc string overloadable no-default c-mode." "result overloadable no-default c-mode.") (define-overloadable-function xref-elisp-overloadable-co-located-default () - "doc string overloadable co-located-default" + "Doc string overloadable co-located-default." "result overloadable co-located-default.") (define-mode-local-override xref-elisp-overloadable-co-located-default c-mode (_start _end &optional _nonterminal _depth _returnonerror) - "doc string overloadable co-located-default c-mode." + "Doc string overloadable co-located-default c-mode." "result overloadable co-located-default c-mode.") (define-overloadable-function xref-elisp-overloadable-separate-default () - "doc string overloadable separate-default.") + "Doc string overloadable separate-default.") (defun xref-elisp-overloadable-separate-default-default () - "doc string overloadable separate-default default" + "Doc string overloadable separate-default default." "result overloadable separate-default.") (define-mode-local-override xref-elisp-overloadable-separate-default c-mode (_start _end &optional _nonterminal _depth _returnonerror) - "doc string overloadable separate-default c-mode." + "Doc string overloadable separate-default c-mode." "result overloadable separate-default c-mode.") (xref-elisp-deftest find-defs-define-overload-no-methods @@ -746,15 +749,11 @@ to (xref-elisp-test-descr-to-target xref)." ;; Source for both variable and defun is "(define-minor-mode ;; compilation-minor-mode". There is no way to tell that directly from ;; the symbol, but we can use (memq sym minor-mode-list) to detect -;; that the symbol is a minor mode. See `elisp--xref-find-definitions' -;; for more comments. -;; -;; IMPROVEME: return defvar instead of defun if source near starting -;; point indicates the user is searching for a variable, not a -;; function. +;; that the symbol is a minor mode. In non-filtering mode we only +;; return the function. (require 'compile) ;; not loaded by default at test time (xref-elisp-deftest find-defs-defun-defvar-el - (elisp--xref-find-definitions 'compilation-minor-mode) + (xref-backend-definitions 'elisp "compilation-minor-mode") (list (cons (xref-make "(defun compilation-minor-mode)" @@ -764,12 +763,27 @@ to (xref-elisp-test-descr-to-target xref)." "(define-minor-mode compilation-minor-mode") )) +;; Returning only defvar because source near point indicates the user +;; is searching for a variable, not a function. +(xref-elisp-deftest find-defs-minor-defvar-c + (with-temp-buffer + (emacs-lisp-mode) + (insert "(foo overwrite-mode") + (xref-backend-definitions 'elisp + (xref-backend-identifier-at-point 'elisp))) + (list + (cons + (xref-make "(defvar overwrite-mode)" + (xref-make-elisp-location 'overwrite-mode 'defvar "src/buffer.c")) + "DEFVAR_PER_BUFFER (\"overwrite-mode\"") + )) + (xref-elisp-deftest find-defs-defvar-el - (elisp--xref-find-definitions 'xref--marker-ring) + (elisp--xref-find-definitions 'xref--history) (list - (xref-make "(defvar xref--marker-ring)" + (xref-make "(defvar xref--history)" (xref-make-elisp-location - 'xref--marker-ring 'defvar + 'xref--history 'defvar (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) )) @@ -825,18 +839,6 @@ to (xref-elisp-test-descr-to-target xref)." (insert "?\\N{HEAVY CHECK MARK}") (should (equal (elisp--preceding-sexp) ?\N{HEAVY CHECK MARK})))) -(ert-deftest elisp-indent-basic () - (with-temp-buffer - (emacs-lisp-mode) - (let ((orig "(defun x () - (print (quote ( thingy great - stuff))) - (print (quote (thingy great - stuff))))")) - (insert orig) - (indent-region (point-min) (point-max)) - (should (equal (buffer-string) orig))))) - (defun test--font (form search) (with-temp-buffer (emacs-lisp-mode) @@ -893,5 +895,218 @@ to (xref-elisp-test-descr-to-target xref)." "(\\(when\\)") nil))) +(defmacro elisp-mode-test--with-buffer (text-with-pos &rest body) + "Eval BODY with buffer and variables from TEXT-WITH-POS. +All occurrences of {NAME} are removed from TEXT-WITH-POS and +the remaining text put in a buffer in `elisp-mode'. +Each NAME is then bound to its position in the text during the +evaluation of BODY." + (declare (indent 1)) + (let* ((annot-text (eval text-with-pos t)) + (pieces nil) + (positions nil) + (tlen (length annot-text)) + (ofs 0) + (text-ofs 0)) + (while + (and (< ofs tlen) + (let ((m (string-match (rx "{" (group (+ (not "}"))) "}") + annot-text ofs))) + (and m + (let ((var (intern (match-string 1 annot-text)))) + (push (substring annot-text ofs m) pieces) + (setq text-ofs (+ text-ofs (- m ofs))) + (push (list var (1+ text-ofs)) positions) + (setq ofs (match-end 0)) + t))))) + (push (substring annot-text ofs tlen) pieces) + (let ((text (apply #'concat (nreverse pieces))) + (bindings (nreverse positions))) + `(with-temp-buffer + (ert-info (,text :prefix "text: ") + (emacs-lisp-mode) + (insert ,text) + (let ,bindings . ,body)))))) + +(ert-deftest elisp-mode-with-buffer () + ;; Sanity test of macro, also demonstrating how it works. + (elisp-mode-test--with-buffer + "{a}123{b}45{c}6" + (should (equal a 1)) + (should (equal b 4)) + (should (equal c 6)) + (should (equal (buffer-string) "123456")))) + +(ert-deftest elisp-mode-infer-namespace () + (elisp-mode-test--with-buffer + (concat " ({p1}alphaX {p2}beta {p3}gamma '{p4}delta\n" + " #'{p5}epsilon `{p6}zeta `(,{p7}eta ,@{p8}theta))\n") + (should (equal (elisp--xref-infer-namespace p1) 'function)) + (should (equal (elisp--xref-infer-namespace p2) 'maybe-variable)) + (should (equal (elisp--xref-infer-namespace p3) 'maybe-variable)) + (should (equal (elisp--xref-infer-namespace p4) 'any)) + (should (equal (elisp--xref-infer-namespace p5) 'function)) + (should (equal (elisp--xref-infer-namespace p6) 'any)) + (should (equal (elisp--xref-infer-namespace p7) 'variable)) + (should (equal (elisp--xref-infer-namespace p8) 'variable))) + + (elisp-mode-test--with-buffer + (concat "(let ({p1}alpha {p2}beta ({p3}gamma {p4}delta))\n" + " ({p5}epsilon {p6}zeta)\n" + " {p7}eta)\n") + (should (equal (elisp--xref-infer-namespace p1) 'variable)) + (should (equal (elisp--xref-infer-namespace p2) 'variable)) + (should (equal (elisp--xref-infer-namespace p3) 'variable)) + (should (equal (elisp--xref-infer-namespace p4) 'variable)) + (should (equal (elisp--xref-infer-namespace p5) 'function)) + (should (equal (elisp--xref-infer-namespace p6) 'maybe-variable)) + (should (equal (elisp--xref-infer-namespace p7) 'variable))) + + (elisp-mode-test--with-buffer + (concat "(let (({p1}alpha {p2}beta)\n" + " ({p3}gamma ({p4}delta {p5}epsilon)))\n" + " ({p6}zeta))\n") + (should (equal (elisp--xref-infer-namespace p1) 'variable)) + (should (equal (elisp--xref-infer-namespace p2) 'variable)) + (should (equal (elisp--xref-infer-namespace p3) 'variable)) + (should (equal (elisp--xref-infer-namespace p4) 'function)) + (should (equal (elisp--xref-infer-namespace p5) 'maybe-variable)) + (should (equal (elisp--xref-infer-namespace p6) 'function))) + + (elisp-mode-test--with-buffer + (concat "(defun {p1}alpha () {p2}beta)\n" + "(defface {p3}gamma ...)\n" + "(defvar {p4}delta {p5}epsilon)\n" + "(function {p6}zeta)\n") + (should (equal (elisp--xref-infer-namespace p1) 'function)) + (should (equal (elisp--xref-infer-namespace p2) 'variable)) + (should (equal (elisp--xref-infer-namespace p3) 'face)) + (should (equal (elisp--xref-infer-namespace p4) 'variable)) + (should (equal (elisp--xref-infer-namespace p5) 'variable)) + (should (equal (elisp--xref-infer-namespace p6) 'function))) + + (elisp-mode-test--with-buffer + (concat "(require '{p1}alpha)\n" + "(fboundp '{p2}beta)\n" + "(boundp '{p3}gamma)\n" + "(facep '{p4}delta)\n" + "(define-key map [f1] '{p5}epsilon)\n") + (should (equal (elisp--xref-infer-namespace p1) 'feature)) + (should (equal (elisp--xref-infer-namespace p2) 'function)) + (should (equal (elisp--xref-infer-namespace p3) 'variable)) + (should (equal (elisp--xref-infer-namespace p4) 'face)) + (should (equal (elisp--xref-infer-namespace p5) 'function))) + + (elisp-mode-test--with-buffer + (concat "(list {p1}alpha {p2}beta)\n" + "(progn {p3}gamma {p4}delta)\n" + "(lambda ({p5}epsilon {p6}zeta) {p7}eta)\n") + (should (equal (elisp--xref-infer-namespace p1) 'variable)) + (should (equal (elisp--xref-infer-namespace p2) 'variable)) + (should (equal (elisp--xref-infer-namespace p3) 'variable)) + (should (equal (elisp--xref-infer-namespace p4) 'variable)) + (should (equal (elisp--xref-infer-namespace p5) 'variable)) + (should (equal (elisp--xref-infer-namespace p6) 'variable)) + (should (equal (elisp--xref-infer-namespace p7) 'variable))) + + (elisp-mode-test--with-buffer + (concat "'({p1}alpha {p2}beta\n" + " ({p3}gamma ({p4}delta)))\n") + (should (equal (elisp--xref-infer-namespace p1) 'any)) + (should (equal (elisp--xref-infer-namespace p2) 'any)) + (should (equal (elisp--xref-infer-namespace p3) 'any)) + (should (equal (elisp--xref-infer-namespace p4) 'any)))) + + +(ert-deftest elisp-shorthand-read-buffer () + (let* ((gsym (downcase (symbol-name (cl-gensym "sh-")))) + (shorthand-sname (format "s-%s" gsym)) + (expected (intern (format "shorthand-longhand-%s" gsym)))) + (cl-assert (not (intern-soft shorthand-sname))) + (should (equal (let ((read-symbol-shorthands + '(("s-" . "shorthand-longhand-")))) + (with-temp-buffer + (insert shorthand-sname) + (goto-char (point-min)) + (read (current-buffer)))) + expected)) + (should (not (intern-soft shorthand-sname))))) + +(ert-deftest elisp-shorthand-read-from-string () + (let* ((gsym (downcase (symbol-name (cl-gensym "sh-")))) + (shorthand-sname (format "s-%s" gsym)) + (expected (intern (format "shorthand-longhand-%s" gsym)))) + (cl-assert (not (intern-soft shorthand-sname))) + (should (equal (let ((read-symbol-shorthands + '(("s-" . "shorthand-longhand-")))) + (car (read-from-string shorthand-sname))) + expected)) + (should (not (intern-soft shorthand-sname))))) + +(ert-deftest elisp-shorthand-load-a-file () + (let ((test-file (ert-resource-file "simple-shorthand-test.el"))) + (mapatoms (lambda (s) + (when (string-match "^elisp--foo-" (symbol-name s)) + (unintern s obarray)))) + (load test-file) + (should (intern-soft "elisp--foo-test")) + (should-not (intern-soft "f-test")))) + +(ert-deftest elisp-shorthand-byte-compile-a-file () + + (let ((test-file (ert-resource-file "simple-shorthand-test.el")) + (byte-compiled (ert-resource-file "simple-shorthand-test.elc"))) + (mapatoms (lambda (s) + (when (string-match "^elisp--foo-" (symbol-name s)) + (unintern s obarray)))) + (byte-compile-file test-file) + (should-not (intern-soft "f-test")) + (should (intern-soft "elisp--foo-test")) + (should-not (fboundp (intern-soft "elisp--foo-test"))) + (load byte-compiled) + (should (intern-soft "elisp--foo-test")) + (should-not (intern-soft "f-test")))) + +(ert-deftest elisp-shorthand-completion-at-point () + (let ((test-file (ert-resource-file "simple-shorthand-test.el"))) + (load test-file) + (with-current-buffer (find-file-noselect test-file) + (revert-buffer t t) + (goto-char (point-min)) + (insert "f-test-compl") + (completion-at-point) + (goto-char (point-min)) + (should (search-forward "f-test-complete-me" (line-end-position) t)) + (goto-char (point-min)) + (should (string= (symbol-name (read (current-buffer))) + "elisp--foo-test-complete-me")) + (revert-buffer t t)))) + +(ert-deftest elisp-shorthand-escape () + (let ((test-file (ert-resource-file "simple-shorthand-test.el"))) + (load test-file) + (should (intern-soft "f-test4---")) + (should-not (intern-soft "elisp--foo-test4---")) + (should (= 84 (funcall (intern-soft "f-test4---")))) + (should (unintern "f-test4---")))) + +(ert-deftest elisp-dont-shadow-punctuation-only-symbols () + (let* ((shorthanded-form '(/= 42 (-foo 42))) + (expected-longhand-form '(/= 42 (fooey-foo 42))) + (observed (let ((read-symbol-shorthands + '(("-" . "fooey-")))) + (car (read-from-string + (with-temp-buffer + (print shorthanded-form (current-buffer)) + (buffer-string))))))) + (should (equal observed expected-longhand-form)))) + +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "elisp-indents.erts")) + (ert-test-erts-file (ert-resource-file "flet.erts") + (lambda () + (emacs-lisp-mode) + (indent-region (point-min) (point-max))))) + (provide 'elisp-mode-tests) ;;; elisp-mode-tests.el ends here diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el index 35a2592e76f..32b73f101e1 100644 --- a/test/lisp/progmodes/etags-tests.el +++ b/test/lisp/progmodes/etags-tests.el @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'etags) (eval-when-compile (require 'cl-lib)) @@ -95,19 +96,19 @@ (ert-deftest etags-buffer-local-tags-table-list () "Test that a buffer-local value of `tags-table-list' is used." - (let ((file (make-temp-file "etag-test-tmpfile"))) - (unwind-protect - (progn - (set-buffer (find-file-noselect file)) - (fundamental-mode) - (setq-local tags-table-list - (list (expand-file-name "manual/etags/ETAGS.good_3" - etags-tests--test-dir))) - (cl-letf ((tag-tables tags-table-list) - (tags-file-name nil) - ((symbol-function 'read-file-name) - (lambda (&rest _) - (error "We should not prompt the user")))) - (should (visit-tags-table-buffer)) - (should (equal tags-file-name (car tag-tables))))) - (delete-file file)))) + (ert-with-temp-file file + :suffix "etag-test-tmpfile" + (set-buffer (find-file-noselect file)) + (fundamental-mode) + (setq-local tags-table-list + (list (expand-file-name "manual/etags/ETAGS.good_3" + etags-tests--test-dir))) + (cl-letf ((tag-tables tags-table-list) + (tags-file-name nil) + ((symbol-function 'read-file-name) + (lambda (&rest _) + (error "We should not prompt the user")))) + (should (visit-tags-table-buffer)) + (should (equal tags-file-name (car tag-tables)))))) + +;;; etags-tests.el ends here diff --git a/test/lisp/progmodes/flymake-resources/another-problematic-file.c b/test/lisp/progmodes/flymake-resources/another-problematic-file.c new file mode 100644 index 00000000000..03eacdd8011 --- /dev/null +++ b/test/lisp/progmodes/flymake-resources/another-problematic-file.c @@ -0,0 +1,5 @@ +#include "some-problems.h" + +int frob(char* freb) { + return 42; +} diff --git a/test/lisp/progmodes/flymake-resources/some-problems.h b/test/lisp/progmodes/flymake-resources/some-problems.h index 165d8dd525e..86ea2de3b0d 100644 --- a/test/lisp/progmodes/flymake-resources/some-problems.h +++ b/test/lisp/progmodes/flymake-resources/some-problems.h @@ -2,4 +2,6 @@ strange; +int frob(char); + sint main(); diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index bda1b663c22..4840018236a 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -23,6 +23,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'flymake) (eval-when-compile (require 'subr-x)) ; string-trim @@ -60,7 +61,7 @@ (cl-defun flymake-tests--call-with-fixture (fn file &key (severity-predicate nil sev-pred-supplied-p)) - "Call FN after flymake setup in FILE, using `flymake-proc`. + "Call FN after flymake setup in FILE, using `flymake-proc'. SEVERITY-PREDICATE is used to setup `flymake-proc-diagnostic-type-pred'" (let* ((file (expand-file-name file flymake-tests-data-directory)) @@ -109,7 +110,7 @@ SEVERITY-PREDICATE is used to setup (face-at-point))))) (ert-deftest perl-backend () - "Test the perl backend" + "Test the perl backend." (skip-unless (executable-find "perl")) (flymake-tests--with-flymake ("test.pl") (flymake-goto-next-error) @@ -120,25 +121,24 @@ SEVERITY-PREDICATE is used to setup (defvar ruby-mode-hook) (ert-deftest ruby-backend () - "Test the ruby backend" + "Test the ruby backend." (skip-unless (executable-find "ruby")) ;; Some versions of ruby fail if HOME doesn't exist (bug#29187). - (let* ((tempdir (make-temp-file "flymake-tests-ruby" t)) - (process-environment (cons (format "HOME=%s" tempdir) - process-environment)) - ;; And see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19657#20 - ;; for this particular yuckiness - (abbreviated-home-dir nil)) - (unwind-protect - (let ((ruby-mode-hook - (lambda () - (setq flymake-diagnostic-functions '(ruby-flymake-simple))))) - (flymake-tests--with-flymake ("test.rb") - (flymake-goto-next-error) - (should (eq 'flymake-warning (face-at-point))) - (flymake-goto-next-error) - (should (eq 'flymake-error (face-at-point))))) - (delete-directory tempdir t)))) + (ert-with-temp-directory tempdir + :suffix "flymake-tests-ruby" + (let* ((process-environment (cons (format "HOME=%s" tempdir) + process-environment)) + ;; And see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19657#20 + ;; for this particular yuckiness + (abbreviated-home-dir nil) + (ruby-mode-hook + (lambda () + (setq flymake-diagnostic-functions '(ruby-flymake-simple))))) + (flymake-tests--with-flymake ("test.rb") + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) + (flymake-goto-next-error) + (should (eq 'flymake-error (face-at-point))))))) (ert-deftest different-diagnostic-types () "Test GCC warning via function predicate." @@ -193,7 +193,7 @@ SEVERITY-PREDICATE is used to setup (defun flymake-tests--diagnose-words (report-fn type words) - "Helper. Call REPORT-FN with diagnostics for WORDS in buffer." + "Helper. Call REPORT-FN with diagnostics for WORDS in buffer." (funcall report-fn (cl-loop for word in words @@ -234,7 +234,7 @@ SEVERITY-PREDICATE is used to setup (lambda (_report-fn) ;; HACK: Shoosh log during tests (setq-local warning-minimum-log-level :emergency) - (error "crashed")))) + (error "Crashed")))) (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore manha aliqua. Ut enim ad minim veniam, quis nostrud @@ -291,7 +291,7 @@ SEVERITY-PREDICATE is used to setup (should-error (flymake-goto-next-error nil nil t)))))) (ert-deftest recurrent-backend () - "Test a backend that calls REPORT-FN multiple times" + "Test a backend that calls REPORT-FN multiple times." (with-temp-buffer (let (tick) (cl-letf @@ -374,4 +374,4 @@ SEVERITY-PREDICATE is used to setup (provide 'flymake-tests) -;;; flymake.el ends here +;;; flymake-tests.el ends here diff --git a/test/lisp/progmodes/gdb-mi-tests.el b/test/lisp/progmodes/gdb-mi-tests.el index ab482214afb..d66df961b63 100644 --- a/test/lisp/progmodes/gdb-mi-tests.el +++ b/test/lisp/progmodes/gdb-mi-tests.el @@ -17,6 +17,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;; Code: + (require 'ert) (require 'gdb-mi) @@ -44,3 +46,5 @@ ) (provide 'gdb-mi-tests) + +;;; gdb-mi-tests.el ends here diff --git a/test/lisp/progmodes/opascal-tests.el b/test/lisp/progmodes/opascal-tests.el index 682f2c6cb6b..ea91479362d 100644 --- a/test/lisp/progmodes/opascal-tests.el +++ b/test/lisp/progmodes/opascal-tests.el @@ -17,6 +17,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;; Code: + (require 'ert) (require 'opascal) diff --git a/test/lisp/progmodes/pascal-tests.el b/test/lisp/progmodes/pascal-tests.el index e9c705806b3..f5202143e20 100644 --- a/test/lisp/progmodes/pascal-tests.el +++ b/test/lisp/progmodes/pascal-tests.el @@ -17,6 +17,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;; Code: + (require 'ert) (require 'pascal) @@ -61,3 +63,5 @@ (should (equal (point) 15)))) (provide 'pascal-tests) + +;;; pascal-tests.el ends here diff --git a/test/lisp/progmodes/perl-mode-tests.el b/test/lisp/progmodes/perl-mode-tests.el index f63f8ad7253..3f4af5e1f61 100644 --- a/test/lisp/progmodes/perl-mode-tests.el +++ b/test/lisp/progmodes/perl-mode-tests.el @@ -21,6 +21,13 @@ (require 'perl-mode) +(ert-deftest perl-test-lock () + (with-temp-buffer + (perl-mode) + (insert "$package = foo;") + (font-lock-ensure (point-min) (point-max)) + (should (equal (get-text-property 4 'face) 'font-lock-variable-name-face)))) + ;;;; Re-use cperl-mode tests (defvar cperl-test-mode) diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 68460a9fa5b..a469414a743 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -29,29 +29,17 @@ (require 'cl-lib) (require 'ert) +(require 'ert-x) ; ert-with-temp-directory (require 'grep) (require 'xref) -(defmacro project-tests--with-temporary-directory (var &rest body) - "Create a new temporary directory. -Bind VAR to the name of the directory, and evaluate BODY. Delete -the directory after BODY exits." - (declare (debug (symbolp body)) (indent 1)) - (cl-check-type var symbol) - (let ((directory (make-symbol "directory"))) - `(let ((,directory (make-temp-file "project-tests-" :directory))) - (unwind-protect - (let ((,var ,directory)) - ,@body) - (delete-directory ,directory :recursive))))) - (ert-deftest project/quoted-directory () "Check that `project-files' and `project-find-regexp' deal with quoted directory names (Bug#47799)." (skip-unless (executable-find find-program)) (skip-unless (executable-find "xargs")) (skip-unless (executable-find "grep")) - (project-tests--with-temporary-directory directory + (ert-with-temp-directory directory (let ((default-directory directory) (project-current-inhibit-prompt t) (project-find-functions nil) @@ -95,7 +83,7 @@ quoted directory names (Bug#47799)." returned by `project-ignores' if the root directory is a directory name (Bug#48471)." (skip-unless (executable-find find-program)) - (project-tests--with-temporary-directory dir + (ert-with-temp-directory dir (make-empty-file (expand-file-name "some-file" dir)) (make-empty-file (expand-file-name "ignored-file" dir)) (let* ((project (make-project-tests--trivial @@ -107,4 +95,19 @@ directory name (Bug#48471)." collect (file-relative-name file dir)))) (should (equal relative-files '("some-file")))))) +(ert-deftest project-ignores-bug-50240 () + "Check that `project-files' does not ignore all files. +When `project-ignores' includes a name matching project dir." + (skip-unless (executable-find find-program)) + (ert-with-temp-directory dir + (make-empty-file (expand-file-name "some-file" dir)) + (let* ((project (make-project-tests--trivial + :root (file-name-as-directory dir) + :ignores (list (file-name-nondirectory + (directory-file-name dir))))) + (files (project-files project))) + (should (equal files + (list + (expand-file-name "some-file" dir))))))) + ;;; project-tests.el ends here diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1af579bb7a4..15bda5c197a 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'python) ;; Dependencies for testing: @@ -48,17 +49,17 @@ BODY is code to be executed within the temp buffer. Point is always located at the beginning of buffer." (declare (indent 1) (debug t)) ;; temp-file never actually used for anything? - `(let* ((temp-file (make-temp-file "python-tests" nil ".py")) - (buffer (find-file-noselect temp-file)) - (python-indent-guess-indent-offset nil)) - (unwind-protect - (with-current-buffer buffer - (python-mode) - (insert ,contents) - (goto-char (point-min)) - ,@body) - (and buffer (kill-buffer buffer)) - (delete-file temp-file)))) + `(ert-with-temp-file temp-file + :suffix "-python.py" + (let ((buffer (find-file-noselect temp-file)) + (python-indent-guess-indent-offset nil)) + (unwind-protect + (with-current-buffer buffer + (python-mode) + (insert ,contents) + (goto-char (point-min)) + ,@body) + (and buffer (kill-buffer buffer)))))) (defun python-tests-look-at (string &optional num restore-point) "Move point at beginning of STRING in the current buffer. @@ -193,7 +194,6 @@ aliqua." (ert-deftest python-syntax-after-python-backspace () ;; `python-indent-dedent-line-backspace' garbles syntax - :expected-result :failed (python-tests-with-temp-buffer "\"\"\"" (goto-char (point-max)) @@ -5283,7 +5283,7 @@ urlpatterns = patterns('', (should (= (current-indentation) 23)))) (or eim (electric-indent-mode -1))))) -(ert-deftest python-triple-quote-pairing () +(ert-deftest python-triple-double-quote-pairing () (let ((epm electric-pair-mode)) (unwind-protect (progn @@ -5310,6 +5310,33 @@ urlpatterns = patterns('', "\"\n\"\"\"\n")))) (or epm (electric-pair-mode -1))))) +(ert-deftest python-triple-single-quote-pairing () + (let ((epm electric-pair-mode)) + (unwind-protect + (progn + (python-tests-with-temp-buffer + "''\n" + (or epm (electric-pair-mode 1)) + (goto-char (1- (point-max))) + (python-tests-self-insert ?') + (should (string= (buffer-string) + "''''''\n")) + (should (= (point) 4))) + (python-tests-with-temp-buffer + "\n" + (python-tests-self-insert (list ?' ?' ?')) + (should (string= (buffer-string) + "''''''\n")) + (should (= (point) 4))) + (python-tests-with-temp-buffer + "'\n''\n" + (goto-char (1- (point-max))) + (python-tests-self-insert ?') + (should (= (point) (1- (point-max)))) + (should (string= (buffer-string) + "'\n'''\n")))) + (or epm (electric-pair-mode -1))))) + ;;; Hideshow support diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index e2ea0d91370..2168b38484e 100644 --- a/test/lisp/progmodes/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el @@ -357,7 +357,7 @@ VALUES-PLIST is a list with alternating index and value elements." (let ((ruby-align-chained-calls t)) (ruby-should-indent-buffer "one.two.three - | .four + | .four | |my_array.select { |str| str.size > 5 } | .map { |str| str.downcase }" @@ -875,6 +875,28 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby-mode-set-encoding) (should (string= "# coding: iso-8859-15\nⓇ" (buffer-string)))))) +(ert-deftest ruby-imenu-with-private-modifier () + (ruby-with-temp-buffer + (ruby-test-string + "class Blub + | def hi + | 'Hi!' + | end + | + | def bye + | 'Bye!' + | end + | + | private def hiding + | 'You can't see me' + | end + |end") + (should (equal (mapcar #'car (ruby-imenu-create-index)) + '("Blub" + "Blub#hi" + "Blub#bye" + "Blub#hiding"))))) + (ert-deftest ruby--indent/converted-from-manual-test () :tags '(:expensive-test) ;; Converted from manual test. @@ -886,6 +908,33 @@ VALUES-PLIST is a list with alternating index and value elements." (should (equal (buffer-string) orig)))) (kill-buffer buf)))) +(ert-deftest ruby--test-chained-indentation () + (with-temp-buffer + (ruby-mode) + (setq-local ruby-align-chained-calls t) + (insert "some_variable.where +.not(x: nil) +.where(y: 2) +") + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) + "some_variable.where + .not(x: nil) + .where(y: 2) +"))) + + (with-temp-buffer + (ruby-mode) + (setq-local ruby-align-chained-calls t) + (insert "some_variable.where.not(x: nil) +.where(y: 2) +") + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) + "some_variable.where.not(x: nil) + .where(y: 2) +")))) + (provide 'ruby-mode-tests) ;;; ruby-mode-tests.el ends here diff --git a/test/lisp/progmodes/sh-script-tests.el b/test/lisp/progmodes/sh-script-tests.el new file mode 100644 index 00000000000..c21010c8b43 --- /dev/null +++ b/test/lisp/progmodes/sh-script-tests.el @@ -0,0 +1,51 @@ +;;; sh-script-tests.el --- Tests for sh-script.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'sh-script) +(require 'ert) + +(ert-deftest test-sh-script-indentation () + (with-temp-buffer + (insert "relative-path/to/configure --prefix=$prefix\\ + --with-x") + (shell-script-mode) + (goto-char (point-min)) + (forward-line 1) + (indent-for-tab-command) + (should (equal + (buffer-substring-no-properties (point-min) (point-max)) + "relative-path/to/configure --prefix=$prefix\\ + --with-x")))) + +(ert-deftest test-basic-sh-indentation () + (with-temp-buffer + (insert "myecho () {\necho foo\n}\n") + (shell-script-mode) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) + "myecho () { + echo foo +} +")))) + +;;; sh-script-tests.el ends here diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 21dd0649529..1bbe3a95e90 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -28,6 +28,7 @@ (require 'cl-lib) (require 'ert) +(require 'ert-x) (require 'sql) (ert-deftest sql-tests-postgres-list-databases () @@ -50,7 +51,7 @@ (lambda (_command) t)) ((symbol-function 'process-lines) (lambda (_program &rest _args) - (error "some error")))) + (error "Some error")))) (should-not (sql-postgres-list-databases)))) ;;; Check Connection Password Handling/Wallet @@ -63,52 +64,49 @@ Identify tests by ID. Set :sql-login dialect attribute to LOGIN-PARAMS. Provide the CONNECTION parameters and the EXPECTED string of values passed to the comint function for validation." (declare (indent 2)) - `(cl-letf - ((sql-test-login-params ' ,login-params) - ((symbol-function 'sql-comint-test) - (lambda (product options &optional buf-name) - (with-current-buffer (get-buffer-create buf-name) - (insert (pp-to-string (list product options sql-user sql-password sql-server sql-database)))))) - ((symbol-function 'sql-run-test) - (lambda (&optional buffer) - (interactive "P") - (sql-product-interactive 'sqltest buffer))) - (sql-user nil) - (sql-server nil) - (sql-database nil) - (sql-product-alist - '((ansi) - (sqltest - :name "SqlTest" - :sqli-login sql-test-login-params - :sqli-comint-func sql-comint-test))) - (sql-connection-alist - '((,(format "test-%s" id) - ,@connection))) - (sql-password-wallet - (list - (make-temp-file - "sql-test-netrc" nil nil - (mapconcat #'identity - '("machine aMachine user aUserName password \"netrc-A aPassword\"" - "machine aServer user aUserName password \"netrc-B aPassword\"" - "machine aMachine server aServer user aUserName password \"netrc-C aPassword\"" - "machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\"" - "machine aDatabase user aUserName password \"netrc-E aPassword\"" - "machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\"" - "machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\"" - ) "\n"))))) - - (let* ((connection ,(format "test-%s" id)) - (buffername (format "*SQL: ERT TEST <%s>*" connection))) - (when (get-buffer buffername) - (kill-buffer buffername)) - (sql-connect connection buffername) - (should (get-buffer buffername)) - (should (string-equal (with-current-buffer buffername (buffer-string)) ,expected)) - (when (get-buffer buffername) - (kill-buffer buffername)) - (delete-file (car sql-password-wallet))))) + `(ert-with-temp-file tempfile + :suffix "sql-test-netrc" + :text (concat + "machine aMachine user aUserName password \"netrc-A aPassword\"" + "machine aServer user aUserName password \"netrc-B aPassword\"" + "machine aMachine server aServer user aUserName password \"netrc-C aPassword\"" + "machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\"" + "machine aDatabase user aUserName password \"netrc-E aPassword\"" + "machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\"" + "machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\"" + "\n") + (cl-letf + ((sql-test-login-params ' ,login-params) + ((symbol-function 'sql-comint-test) + (lambda (product options &optional buf-name) + (with-current-buffer (get-buffer-create buf-name) + (insert (pp-to-string (list product options sql-user sql-password sql-server sql-database)))))) + ((symbol-function 'sql-run-test) + (lambda (&optional buffer) + (interactive "P") + (sql-product-interactive 'sqltest buffer))) + (sql-user nil) + (sql-server nil) + (sql-database nil) + (sql-product-alist + '((ansi) + (sqltest + :name "SqlTest" + :sqli-login sql-test-login-params + :sqli-comint-func sql-comint-test))) + (sql-connection-alist + '((,(format "test-%s" id) + ,@connection))) + (sql-password-wallet (list tempfile))) + (let* ((connection ,(format "test-%s" id)) + (buffername (format "*SQL: ERT TEST <%s>*" connection))) + (when (get-buffer buffername) + (kill-buffer buffername)) + (sql-connect connection buffername) + (should (get-buffer buffername)) + (should (string-equal (with-current-buffer buffername (buffer-string)) ,expected)) + (when (get-buffer buffername) + (kill-buffer buffername)))))) (ert-deftest sql-test-connect () "Test of basic `sql-connect'." @@ -416,6 +414,16 @@ The ACTION will be tested after set-up of PRODUCT." (kill-buffer "*SQL: exist*"))) +(ert-deftest sql-tests-comint-automatic-password () + (let ((sql-password nil)) + (should-not (sql-comint-automatic-password "Password: "))) + (let ((sql-password "")) + (should-not (sql-comint-automatic-password "Password: "))) + (let ((sql-password "password")) + (should (equal "password" (sql-comint-automatic-password "Password: ")))) + ;; Also, we shouldn't care what the password is - we rely on comint for that. + (let ((sql-password "password")) + (should (equal "password" (sql-comint-automatic-password ""))))) (provide 'sql-tests) ;;; sql-tests.el ends here diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index d29452243b2..b1de1a4df5a 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -52,6 +52,14 @@ (should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 0 locs)))) (should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 1 locs)))))) +(ert-deftest xref-matches-in-directory-filters-with-ignores () + (let ((locs (xref-matches-in-directory "bar" "*" xref-tests--data-dir + '("./file1.*")))) + (should (= 1 (length locs))) + (should (string-match-p "file2\\.txt\\'" (xref-location-group + (xref-item-location + (nth 0 locs))))))) + (ert-deftest xref-matches-in-directory-finds-two-matches-on-the-same-line () (let ((locs (xref-tests--locations-in-data-dir "foo"))) (should (= 2 (length locs))) @@ -120,8 +128,12 @@ (let ((xref-file-name-display 'abs)) (should (equal (delete-dups - (mapcar 'xref-location-group - (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) + (mapcar + (lambda (loc) + (xref--group-name-for-display + (xref-location-group loc) + nil)) + (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) (list (concat xref-tests--data-dir "file1.txt") (concat xref-tests--data-dir "file2.txt")))))) @@ -129,8 +141,12 @@ (ert-deftest xref--xref-file-name-display-is-nondirectory () (let ((xref-file-name-display 'nondirectory)) (should (equal (delete-dups - (mapcar 'xref-location-group - (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) + (mapcar + (lambda (loc) + (xref--group-name-for-display + (xref-location-group loc) + nil)) + (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) (list "file1.txt" "file2.txt"))))) @@ -138,13 +154,15 @@ (ert-deftest xref--xref-file-name-display-is-relative-to-project-root () (let* ((data-parent-dir (file-name-directory (directory-file-name xref-tests--data-dir))) - (project-find-functions - (lambda (_) (cons 'transient data-parent-dir))) (xref-file-name-display 'project-relative)) (should (equal (delete-dups - (mapcar 'xref-location-group - (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) + (mapcar + (lambda (loc) + (xref--group-name-for-display + (xref-location-group loc) + data-parent-dir)) + (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)"))) (list "xref-resources/file1.txt" "xref-resources/file2.txt"))))) |