diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2022-09-25 16:15:16 -0400 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2022-09-25 16:15:16 -0400 |
| commit | 650c20f1ca4e07591a727e1cfcc74b3363d15985 (patch) | |
| tree | 85d11f6437cde22f410c25e0e5f71a3131ebd07d /test/lisp/progmodes | |
| parent | 8869332684c2302b5ba1ead4568bbc7ba1c0183e (diff) | |
| parent | 4b85ae6a24380fb67a3315eaec9233f17a872473 (diff) | |
| download | emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.gz emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.bz2 emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.zip | |
Merge 'master' into noverlay
Diffstat (limited to 'test/lisp/progmodes')
73 files changed, 8443 insertions, 471 deletions
diff --git a/test/lisp/progmodes/asm-mode-tests.el b/test/lisp/progmodes/asm-mode-tests.el new file mode 100644 index 00000000000..e321224c543 --- /dev/null +++ b/test/lisp/progmodes/asm-mode-tests.el @@ -0,0 +1,82 @@ +;;; asm-mode-tests.el --- Tests for asm-mode.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2019-2022 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl <simenheg@gmail.com> +;; Keywords: + +;; 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 'asm-mode) +(require 'ert) + +(defmacro asm-mode-tests--with-temp-buffer (&rest body) + "Create a temporary Asm mode buffer and evaluate BODY there." + (declare (indent 0)) + `(with-temp-buffer + (let ((asm-comment-char ?\;)) + (asm-mode) + ,@body))) + +(ert-deftest asm-mode-tests-colon () + (asm-mode-tests--with-temp-buffer + (let ((indent-tabs-mode t)) + (insert "\t label") + (let ((last-command-event ?:)) + (asm-colon)) + (should (equal (buffer-string) "label:\t"))))) + +(ert-deftest asm-mode-tests-colon-inside-comment () + (asm-mode-tests--with-temp-buffer + (insert ";comment") + (let ((last-command-event ?:)) + (asm-colon)) + (should (equal (buffer-string) ";comment:")))) + +(ert-deftest asm-mode-tests-comment () + (asm-mode-tests--with-temp-buffer + (insert "label:") + (goto-char (point-min)) + ;; First invocation + (asm-comment) + (should (string-match-p "label:[ \t]+;" (buffer-string))) + (should (= (current-column) (+ comment-column 1))) + ;; Second invocation + (asm-comment) + (should (string-match-p "[ \t]+;; \nlabel:" (buffer-string))) + (should (= (current-column) (+ tab-width 3))) + ;; Third invocation + (asm-comment) + (should (string-match-p ";;; \nlabel:" (buffer-string))) + (should (= (current-column) 4)))) + +(ert-deftest asm-mode-tests-fill-comment () + (asm-mode-tests--with-temp-buffer + (call-interactively #'comment-dwim) + (insert "Pellentesque condimentum, magna ut suscipit hendrerit, \ +ipsum augue ornare nulla, non luctus diam neque sit amet urna.") + (call-interactively #'fill-paragraph) + (should (equal (buffer-string) "\t;; Pellentesque condimentum, \ +magna ut suscipit hendrerit,\n\t;; ipsum augue ornare nulla, non \ +luctus diam neque sit amet\n\t;; urna.")))) + +;;; asm-mode-tests.el ends here diff --git a/test/lisp/progmodes/autoconf-tests.el b/test/lisp/progmodes/autoconf-tests.el new file mode 100644 index 00000000000..7c609f3c2a7 --- /dev/null +++ b/test/lisp/progmodes/autoconf-tests.el @@ -0,0 +1,55 @@ +;;; autoconf-tests.el --- Tests for autoconf.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl <simenheg@gmail.com> +;; Keywords: + +;; 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 'autoconf) +(require 'ert) + +(ert-deftest autoconf-tests-current-defun-function-define () + (with-temp-buffer + (insert "AC_DEFINE([HAVE_RSVG], [1], [Define to 1 if using librsvg.])") + (goto-char (point-min)) + (should-not (autoconf-current-defun-function)) + (forward-char 11) + (should (equal (autoconf-current-defun-function) "HAVE_RSVG")))) + +(ert-deftest autoconf-tests-current-defun-function-subst () + (with-temp-buffer + (insert "AC_SUBST([srcdir])") + (goto-char (point-min)) + (should-not (autoconf-current-defun-function)) + (forward-char 10) + (should (equal (autoconf-current-defun-function) "srcdir")))) + +(ert-deftest autoconf-tests-autoconf-mode-comment-syntax () + (with-temp-buffer + (autoconf-mode) + (insert "dnl Autoconf script for GNU Emacs") + (should (nth 4 (syntax-ppss))))) + +(provide 'autoconf-tests) +;;; autoconf-tests.el ends here diff --git a/test/lisp/progmodes/bat-mode-tests.el b/test/lisp/progmodes/bat-mode-tests.el index 71660ca437a..5ef4158ec94 100644 --- a/test/lisp/progmodes/bat-mode-tests.el +++ b/test/lisp/progmodes/bat-mode-tests.el @@ -1,6 +1,6 @@ ;;; bat-mode-tests.el --- Tests for bat-mode.el -*- lexical-binding: t; -*- -;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Copyright (C) 2017-2022 Free Software Foundation, Inc. ;; Author: Vladimir Panteleev <vladimir@thecybershadow.net> ;; Keywords: @@ -63,10 +63,11 @@ "Test fontification of iteration variables." (should (equal - (bat-test-fontify "echo %%a\necho %%~dp1\necho %%~$PATH:I") + (bat-test-fontify "echo %%a\necho %%~dp1\necho %%~$PATH:I\necho %%~1") "<span class=\"builtin\">echo</span> %%<span class=\"variable-name\">a</span> <span class=\"builtin\">echo</span> %%~dp<span class=\"variable-name\">1</span> -<span class=\"builtin\">echo</span> %%~$<span class=\"variable-name\">PATH</span>:<span class=\"variable-name\">I</span>"))) +<span class=\"builtin\">echo</span> %%~$<span class=\"variable-name\">PATH</span>:<span class=\"variable-name\">I</span> +<span class=\"builtin\">echo</span> %%~<span class=\"variable-name\">1</span>"))) (defun bat-test-fill-paragraph (str) "Return the result of invoking `fill-paragraph' on STR in a `bat-mode' buffer." diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el new file mode 100644 index 00000000000..fa06d7a1cd0 --- /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-2022 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/cc-mode-tests.el b/test/lisp/progmodes/cc-mode-tests.el index 402bf47dfab..2220721ccf6 100644 --- a/test/lisp/progmodes/cc-mode-tests.el +++ b/test/lisp/progmodes/cc-mode-tests.el @@ -1,6 +1,6 @@ ;;; cc-mode-tests.el --- Test suite for cc-mode. -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2022 Free Software Foundation, Inc. ;; Author: Michal Nazarewicz <mina86@mina86.com> ;; Keywords: internal @@ -40,7 +40,7 @@ (insert content) (setq mode nil) (c-or-c++-mode) - (unless(eq expected mode) + (unless (eq expected mode) (ert-fail (format "expected %s but got %s when testing '%s'" expected mode content))))) @@ -53,11 +53,18 @@ (funcall do-test (concat " * " content) 'c-mode)) '("using \t namespace \t std;" "using \t std::string;" + "using Foo = Bar;" "namespace \t {" "namespace \t foo \t {" - "class \t Blah_42 \t {" + "namespace \t foo::bar \t {" + "inline namespace \t foo \t {" + "inline namespace \t foo::bar \t {" "class \t Blah_42 \t \n" + "class \t Blah_42;" + "class \t Blah_42 \t final {" + "struct \t Blah_42 \t final {" "class \t _42_Blah:public Foo {" + "struct \t _42_Blah:public Foo {" "template \t < class T >" "template< class T >" "#include <string>" @@ -67,6 +74,37 @@ (mapc (lambda (content) (funcall do-test content 'c-mode)) '("struct \t Blah_42 \t {" "struct template {" + "struct Blah;" "#include <string.h>"))))) +(ert-deftest c-mode-macro-comment () + "Test for bug#36484." + (dolist (macro-string '("#define /***/f" + "#define x /***/5" + "#define a(x)get/***/x/***/id())")) + (with-temp-buffer + (insert macro-string) + (c-mode)))) + +(ert-deftest c-lineup-ternary-bodies () + "Test for c-lineup-ternary-bodies function" + (with-temp-buffer + (c-mode) + (let* ((common-prefix "int value = condition ") + (expected-column (length common-prefix))) + (dolist (test '(("? a : \n b" . nil) + ("? a \n ::b" . nil) + ("a \n : b" . nil) + ("? a \n : b" . t) + ("? ::a \n : b" . t) + ("? (p ? q : r) \n : b" . t) + ("? p ?: q \n : b" . t) + ("? p ? : q \n : b" . t) + ("? p ? q : r \n : b" . t))) + (delete-region (point-min) (point-max)) + (insert common-prefix (car test)) + (should (equal + (and (cdr test) (vector expected-column)) + (c-lineup-ternary-bodies '(statement-cont . 1)))))))) + ;;; cc-mode-tests.el ends here diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 2de52daeea2..36bdbe4c91b 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -1,6 +1,6 @@ ;;; compile-tests.el --- Test suite for compile.el. -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2017 Free Software Foundation, Inc. +;; Copyright (C) 2011-2022 Free Software Foundation, Inc. ;; Author: Chong Yidong <cyd@stupidchicken.com> ;; Keywords: internal @@ -30,290 +30,366 @@ (require 'ert) (require 'compile) -(defvar compile-tests--test-regexps-data - ;; The computed column numbers are zero-indexed, so subtract 1 from - ;; what's reported in the string. The end column numbers are for - ;; the character after, so it matches what's reported in the string. +(defconst compile-tests--test-regexps-data '(;; absoft - ("Error on line 3 of t.f: Execution error unclassifiable statement" + (absoft + "Error on line 3 of t.f: Execution error unclassifiable statement" 1 nil 3 "t.f") - ("Line 45 of \"foo.c\": bloofle undefined" + (absoft "Line 45 of \"foo.c\": bloofle undefined" 1 nil 45 "foo.c") - ("error on line 19 of fplot.f: spelling error?" + (absoft "error on line 19 of fplot.f: spelling error?" 1 nil 19 "fplot.f") - ("warning on line 17 of fplot.f: data type is undefined for variable d" + (absoft + "warning on line 17 of fplot.f: data type is undefined for variable d" 1 nil 17 "fplot.f") ;; Ada & Mpatrol - ("foo.adb:61:11: [...] in call to size declared at foo.ads:11" + (gnu "foo.adb:61:11: [...] in call to size declared at foo.ads:11" 1 11 61 "foo.adb") - ("foo.adb:61:11: [...] in call to size declared at foo.ads:11" + (ada "foo.adb:61:11: [...] in call to size declared at foo.ads:11" 52 nil 11 "foo.ads") - (" 0x8008621 main+16 at error.c:17" + (ada " 0x8008621 main+16 at error.c:17" 23 nil 17 "error.c") ;; aix - ("****** Error number 140 in line 8 of file errors.c ******" + (aix "****** Error number 140 in line 8 of file errors.c ******" 25 nil 8 "errors.c") ;; ant - ("[javac] /src/DataBaseTestCase.java:27: unreported exception ..." - 13 nil 27 "/src/DataBaseTestCase.java") - ("[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally" - 13 nil 49 "/src/DataBaseTestCase.java") - ("[jikes] foo.java:3:5:7:9: blah blah" - 14 (5 . 10) (3 . 7) "foo.java") + (ant "[javac] /src/DataBaseTestCase.java:27: unreported exception ..." + 13 nil 27 "/src/DataBaseTestCase.java" 2) + (ant "[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally" + 13 nil 49 "/src/DataBaseTestCase.java" 1) + (ant "[jikes] foo.java:3:5:7:9: blah blah" + 14 (5 . 9) (3 . 7) "foo.java" 2) + (ant "[javac] c:/cygwin/Test.java:12: error: foo: bar" + 9 nil 12 "c:/cygwin/Test.java" 2) + (ant "[javac] c:\\cygwin\\Test.java:87: error: foo: bar" + 9 nil 87 "c:\\cygwin\\Test.java" 2) + ;; Checkstyle error, but ant reports a warning (note additional + ;; severity level after task name) + (ant "[checkstyle] [ERROR] /src/Test.java:38: warning: foo" + 22 nil 38 "/src/Test.java" 1) ;; bash - ("a.sh: line 1: ls-l: command not found" + (bash "a.sh: line 1: ls-l: command not found" 1 nil 1 "a.sh") ;; borland - ("Error ping.c 15: Unable to open include file 'sys/types.h'" + (borland "Error ping.c 15: Unable to open include file 'sys/types.h'" 1 nil 15 "ping.c") - ("Warning pong.c 68: Call to function 'func' with no prototype" + (borland "Warning pong.c 68: Call to function 'func' with no prototype" 1 nil 68 "pong.c") - ("Error E2010 ping.c 15: Unable to open include file 'sys/types.h'" + (borland "Error E2010 ping.c 15: Unable to open include file 'sys/types.h'" 1 nil 15 "ping.c") - ("Warning W1022 pong.c 68: Call to function 'func' with no prototype" + (borland + "Warning W1022 pong.c 68: Call to function 'func' with no prototype" 1 nil 68 "pong.c") ;; caml - ("File \"foobar.ml\", lines 5-8, characters 20-155: blah blah" - 1 (20 . 156) (5 . 8) "foobar.ml") - ("File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ." - 1 (2 . 146) 65 "F:\\ocaml\\sorting.ml") - ("File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children" + (python-tracebacks-and-caml + "File \"foobar.ml\", lines 5-8, characters 20-155: blah blah" + 1 (20 . 155) (5 . 8) "foobar.ml") + (python-tracebacks-and-caml + "File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ." + 1 (2 . 145) 65 "F:\\ocaml\\sorting.ml") + (python-tracebacks-and-caml + "File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children" 1 nil 41 "/usr/share/gdesklets/display/TargetGauge.py") - ("File \\lib\\python\\Products\\PythonScripts\\PythonScript.py, line 302, in _exec" + (python-tracebacks-and-caml + "File \\lib\\python\\Products\\PythonScripts\\PythonScript.py, line 302, in _exec" 1 nil 302 "\\lib\\python\\Products\\PythonScripts\\PythonScript.py") - ("File \"/tmp/foo.py\", line 10" + (python-tracebacks-and-caml + "File \"/tmp/foo.py\", line 10" 1 nil 10 "/tmp/foo.py") ;; clang-include - ("In file included from foo.cpp:2:" + (clang-include "In file included from foo.cpp:2:" 1 nil 2 "foo.cpp" 0) ;; cmake cmake-info - ("CMake Error at CMakeLists.txt:23 (hurz):" + (cmake "CMake Error at CMakeLists.txt:23 (hurz):" 1 nil 23 "CMakeLists.txt") - ("CMake Warning at cmake/modules/UseUG.cmake:73 (find_package):" + (cmake "CMake Warning at cmake/modules/UseUG.cmake:73 (find_package):" 1 nil 73 "cmake/modules/UseUG.cmake") - (" cmake/modules/DuneGridMacros.cmake:19 (include)" + (cmake-info " cmake/modules/DuneGridMacros.cmake:19 (include)" 1 nil 19 "cmake/modules/DuneGridMacros.cmake") ;; comma - ("\"foo.f\", line 3: Error: syntax error near end of statement" + (comma "\"foo.f\", line 3: Error: syntax error near end of statement" 1 nil 3 "foo.f") - ("\"vvouch.c\", line 19.5: 1506-046 (S) Syntax error." + (comma "\"vvouch.c\", line 19.5: 1506-046 (S) Syntax error." 1 5 19 "vvouch.c") - ("\"foo.c\", line 32 pos 1; (E) syntax error; unexpected symbol: \"lossage\"" + (comma "\"foo.c\", line 32 pos 1; (E) syntax error; unexpected symbol: \"lossage\"" 1 1 32 "foo.c") - ("\"foo.adb\", line 2(11): warning: file name does not match ..." + (comma "\"foo.adb\", line 2(11): warning: file name does not match ..." 1 11 2 "foo.adb") - ("\"src/swapping.c\", line 30.34: 1506-342 (W) \"/*\" detected in comment." + (comma + "\"src/swapping.c\", line 30.34: 1506-342 (W) \"/*\" detected in comment." 1 34 30 "src/swapping.c") ;; cucumber - ("Scenario: undefined step # features/cucumber.feature:3" + (cucumber "Scenario: undefined step # features/cucumber.feature:3" 29 nil 3 "features/cucumber.feature") - (" /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" + ;; This rule is actually handled by the `cucumber' pattern but when + ;; `omake' is included, then `gnu' matches it first. + (gnu " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" 1 nil 500 "/home/gusev/.rvm/foo/bar.rb") ;; edg-1 edg-2 - ("build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" + (edg-1 "build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" 1 nil 42 "build/intel/debug/../../../struct.cpp") - ("build/intel/debug/struct.cpp(44): warning #1011: missing return statement at end of" + (edg-1 "build/intel/debug/struct.cpp(44): warning #1011: missing return statement at end of" 1 nil 44 "build/intel/debug/struct.cpp") - ("build/intel/debug/iptr.h(302): remark #981: operands are evaluated in unspecified order" + (edg-1 "build/intel/debug/iptr.h(302): remark #981: operands are evaluated in unspecified order" 1 nil 302 "build/intel/debug/iptr.h") - (" detected during ... at line 62 of \"build/intel/debug/../../../trace.h\"" + (edg-2 " detected during ... at line 62 of \"build/intel/debug/../../../trace.h\"" 31 nil 62 "build/intel/debug/../../../trace.h") ;; epc - ("Error 24 at (2:progran.f90) : syntax error" + (epc "Error 24 at (2:progran.f90) : syntax error" 1 nil 2 "progran.f90") ;; ftnchek - (" Dummy arg W in module SUBA line 8 file arrayclash.f is array" + (ftnchek " Dummy arg W in module SUBA line 8 file arrayclash.f is array" 32 nil 8 "arrayclash.f") - (" L4 used at line 55 file test/assign.f; never set" + (ftnchek " L4 used at line 55 file test/assign.f; never set" 16 nil 55 "test/assign.f") - ("Warning near line 10 file arrayclash.f: Module contains no executable" + (ftnchek + "Warning near line 10 file arrayclash.f: Module contains no executable" 1 nil 10 "arrayclash.f") - ("Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit" + (ftnchek "Nonportable usage near line 31 col 9 file assign.f: mixed default and explicit" 24 9 31 "assign.f") ;; iar - ("\"foo.c\",3 Error[32]: Error message" + (iar "\"foo.c\",3 Error[32]: Error message" 1 nil 3 "foo.c") - ("\"foo.c\",3 Warning[32]: Error message" + (iar "\"foo.c\",3 Warning[32]: Error message" 1 nil 3 "foo.c") ;; ibm - ("foo.c(2:0) : informational EDC0804: Function foo is not referenced." + (ibm "foo.c(2:0) : informational EDC0804: Function foo is not referenced." 1 0 2 "foo.c") - ("foo.c(3:8) : warning EDC0833: Implicit return statement encountered." + (ibm "foo.c(3:8) : warning EDC0833: Implicit return statement encountered." 1 8 3 "foo.c") - ("foo.c(5:5) : error EDC0350: Syntax error." + (ibm "foo.c(5:5) : error EDC0350: Syntax error." 1 5 5 "foo.c") ;; irix - ("ccom: Error: foo.c, line 2: syntax error" + (irix "ccom: Error: foo.c, line 2: syntax error" 1 nil 2 "foo.c") - ("cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file <panel.h> ..." + (irix "cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file <panel.h> ..." 1 nil 17 "/src/Python-2.3.3/Modules/_curses_panel.c") - ("cc: Info: foo.c, line 27: ..." + (irix "cc: Info: foo.c, line 27: ..." 1 nil 27 "foo.c") - ("cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ..." + (irix + "cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ..." 1 nil 2 "foo.c") - ("cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ..." + (irix + "cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ..." 1 nil 170 "xfe.c") - ("/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah" + (irix "/usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah" 1 nil 1 "foo.c") - ("/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah" + (irix "/usr/lib/cmplrs/cc/cfe: warning: foo.c: 1: blah blah" 1 nil 1 "foo.c") - ("foo bar: baz.f, line 27: ..." + (irix "foo bar: baz.f, line 27: ..." 1 nil 27 "baz.f") ;; java - ("\tat org.foo.ComponentGateway.doGet(ComponentGateway.java:172)" + (java "\tat org.foo.ComponentGateway.doGet(ComponentGateway.java:172)" 5 nil 172 "ComponentGateway.java") - ("\tat javax.servlet.http.HttpServlet.service(HttpServlet.java:740)" + (java "\tat javax.servlet.http.HttpServlet.service(HttpServlet.java:740)" 5 nil 740 "HttpServlet.java") - ("==1332== at 0x4040743C: System::getErrorString() (../src/Lib/System.cpp:217)" + (java "==1332== at 0x4040743C: System::getErrorString() (../src/Lib/System.cpp:217)" 13 nil 217 "../src/Lib/System.cpp") - ("==1332== by 0x8008621: main (vtest.c:180)" + (java "==1332== by 0x8008621: main (vtest.c:180)" 13 nil 180 "vtest.c") + ;; javac + (javac + "/src/Test.java:5: ';' expected\n foo foo\n ^\n" + 1 16 5 "/src/Test.java" 2) + (javac + "e:\\src\\Test.java:7: warning: ';' expected\n foo foo\n ^\n" + 1 11 7 "e:\\src\\Test.java" 1) ;; jikes-file jikes-line - ("Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":" + (jikes-file + "Found 2 semantic errors compiling \"../javax/swing/BorderFactory.java\":" 1 nil nil "../javax/swing/BorderFactory.java") - ("Issued 1 semantic warning compiling \"java/awt/Toolkit.java\":" + (jikes-file "Issued 1 semantic warning compiling \"java/awt/Toolkit.java\":" 1 nil nil "java/awt/Toolkit.java") ;; gcc-include - ("In file included from /usr/include/c++/3.3/backward/warn.h:4," + (gcc-include "In file included from /usr/include/c++/3.3/backward/warn.h:4," 1 nil 4 "/usr/include/c++/3.3/backward/warn.h") - (" from /usr/include/c++/3.3/backward/iostream.h:31:0," + (gcc-include + " from /usr/include/c++/3.3/backward/iostream.h:31:0," 1 0 31 "/usr/include/c++/3.3/backward/iostream.h") - (" from test_clt.cc:1:" + (gcc-include " from test_clt.cc:1:" 1 nil 1 "test_clt.cc") + ;; gmake + (gmake "make: *** [Makefile:20: all] Error 2" 12 nil 20 "Makefile" 0) + (gmake "make[4]: *** [sub/make.mk:19: all] Error 127" 15 nil 19 + "sub/make.mk" 0) + (gmake "gmake[4]: *** [sub/make.mk:19: all] Error 2" 16 nil 19 + "sub/make.mk" 0) + (gmake "gmake-4.3[4]: *** [make.mk:1119: all] Error 2" 20 nil 1119 + "make.mk" 0) + (gmake "Make-4.3: *** [make.INC:1119: dir/all] Error 2" 16 nil 1119 + "make.INC" 0) ;; gnu - ("foo.c:8: message" 1 nil 8 "foo.c") - ("../foo.c:8: W: message" 1 nil 8 "../foo.c") - ("/tmp/foo.c:8:warning message" 1 nil 8 "/tmp/foo.c") - ("foo/bar.py:8: FutureWarning message" 1 nil 8 "foo/bar.py") - ("foo.py:8: RuntimeWarning message" 1 nil 8 "foo.py") - ("foo.c:8:I: message" 1 nil 8 "foo.c") - ("foo.c:8.23: note: message" 1 23 8 "foo.c") - ("foo.c:8.23: info: message" 1 23 8 "foo.c") - ("foo.c:8:23:information: message" 1 23 8 "foo.c") - ("foo.c:8.23-45: Informational: message" 1 (23 . 46) (8 . nil) "foo.c") - ("foo.c:8-23: message" 1 nil (8 . 23) "foo.c") + (gnu "foo.c:8: message" 1 nil 8 "foo.c") + (gnu "../foo.c:8: W: message" 1 nil 8 "../foo.c") + (gnu "/tmp/foo.c:8:warning message" 1 nil 8 "/tmp/foo.c") + (gnu "foo/bar.py:8: FutureWarning message" 1 nil 8 "foo/bar.py") + (gnu "foo.py:8: RuntimeWarning message" 1 nil 8 "foo.py") + (gnu "foo.c:8:I: message" 1 nil 8 "foo.c") + (gnu "foo.c:8.23: note: message" 1 23 8 "foo.c") + (gnu "foo.c:8.23: info: message" 1 23 8 "foo.c") + (gnu "foo.c:8:23:information: message" 1 23 8 "foo.c") + (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 45) (8 . nil) "foo.c") + (gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c") + (gnu " |foo.c:8: message" 1 nil 8 "foo.c") ;; The next one is not in the GNU standards AFAICS. ;; Here we seem to interpret it as LINE1-LINE2.COL2. - ("foo.c:8-45.3: message" 1 (nil . 4) (8 . 45) "foo.c") - ("foo.c:8.23-9.1: message" 1 (23 . 2) (8 . 9) "foo.c") - ("jade:dbcommon.dsl:133:17:E: missing argument for function call" + (gnu "foo.c:8-45.3: message" 1 (nil . 3) (8 . 45) "foo.c") + (gnu "foo.c:8.23-9.1: message" 1 (23 . 1) (8 . 9) "foo.c") + (gnu "jade:dbcommon.dsl:133:17:E: missing argument for function call" 1 17 133 "dbcommon.dsl") - ("G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." + (gnu "G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." 1 nil 54 "G:/cygwin/dev/build-myproj.xml") - ("file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." + (gnu "file:G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found." 1 nil 54 "G:/cygwin/dev/build-myproj.xml") - ("{standard input}:27041: Warning: end of file not at end of a line; newline inserted" + (gnu "{standard input}:27041: Warning: end of file not at end of a line; newline inserted" 1 nil 27041 "{standard input}") + (gnu "boost/container/detail/flat_tree.hpp:589:25: [ skipping 5 instantiation contexts, use -ftemplate-backtrace-limit=0 to disable ]" + 1 25 589 "boost/container/detail/flat_tree.hpp" 0) + ;; gradle-kotlin + (gradle-kotlin + "e: /src/Test.kt: (34, 15): foo: bar" 4 15 34 "/src/Test.kt" 2) + (gradle-kotlin + "w: /src/Test.kt: (11, 98): foo: bar" 4 98 11 "/src/Test.kt" 1) + (gradle-kotlin + "e: e:/cygwin/src/Test.kt: (34, 15): foo: bar" + 4 15 34 "e:/cygwin/src/Test.kt" 2) + (gradle-kotlin + "w: e:/cygwin/src/Test.kt: (11, 98): foo: bar" + 4 98 11 "e:/cygwin/src/Test.kt" 1) + (gradle-kotlin + "e: e:\\src\\Test.kt: (34, 15): foo: bar" 4 15 34 "e:\\src\\Test.kt" 2) + (gradle-kotlin + "w: e:\\src\\Test.kt: (11, 98): foo: bar" 4 98 11 "e:\\src\\Test.kt" 1) + (gradle-android + " ERROR:/Users/salutis/src/AndroidSchemeExperiment/app/build/intermediates/incremental/debug/mergeDebugResources/stripped.dir/layout/item.xml:3: AAPT: error: '16dpw' is incompatible with attribute padding (attr) dimension." + 1 nil 3 "/Users/salutis/src/AndroidSchemeExperiment/app/build/intermediates/incremental/debug/mergeDebugResources/stripped.dir/layout/item.xml" 2) ;; Guile - ("In foo.scm:\n" 1 nil nil "foo.scm") - (" 63:4 [call-with-prompt prompt0 ...]" 1 4 63 nil) - ("1038: 1 [main (\"gud-break.scm\")]" 1 1 1038 nil) + (guile-file "In foo.scm:\n" 1 nil nil "foo.scm") + (guile-line " 63:4 [call-with-prompt prompt0 ...]" 1 4 63 nil) + (guile-line "1038: 1 [main (\"gud-break.scm\")]" 1 1 1038 nil) ;; lcc - ("E, file.cc(35,52) Illegal operation on pointers" 1 52 35 "file.cc") - ("W, file.cc(36,52) blah blah" 1 52 36 "file.cc") + (lcc "E, file.cc(35,52) Illegal operation on pointers" 1 52 35 "file.cc") + (lcc "W, file.cc(36,52) blah blah" 1 52 36 "file.cc") ;; makepp - ("makepp: Scanning `/foo/bar.c'" 19 nil nil "/foo/bar.c") - ("makepp: warning: bla bla `/foo/bar.c' and `/foo/bar.h'" 27 nil nil "/foo/bar.c") - ("makepp: bla bla `/foo/Makeppfile:12' bla" 18 nil 12 "/foo/Makeppfile") - ("makepp: bla bla `/foo/bar.c' and `/foo/bar.h'" 35 nil nil "/foo/bar.h") + (makepp "makepp: Scanning `/foo/bar.c'" 19 nil nil "/foo/bar.c") + (makepp "makepp: warning: bla bla `/foo/bar.c' and `/foo/bar.h'" + 27 nil nil "/foo/bar.c") + (makepp "makepp: bla bla `/foo/Makeppfile:12' bla" + 18 nil 12 "/foo/Makeppfile") + (nil "makepp: bla bla `/foo/bar.c' and `/foo/bar.h'" + 35 nil nil "/foo/bar.h") ;; maven - ("FooBar.java:[111,53] no interface expected here" + (maven "FooBar.java:[111,53] no interface expected here" 1 53 111 "FooBar.java" 2) - (" [ERROR] /Users/cinsk/hello.java:[651,96] ';' expected" + (maven "[ERROR] /Users/cinsk/hello.java:[651,96] ';' expected" 15 96 651 "/Users/cinsk/hello.java" 2) ;Bug#11517. - ("[WARNING] /foo/bar/Test.java:[27,43] unchecked conversion" + (maven "[WARNING] /foo/bar/Test.java:[27,43] unchecked conversion" 11 43 27 "/foo/bar/Test.java" 1) ;Bug#20556 ;; mips-1 mips-2 - ("TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" + (mips-1 "TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" 11 nil 255 "solomon.c") - ("TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" + (mips-1 "TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomo.c due to truncation" 70 nil 93 "solomo.c") - ("name defined but never used: LinInt in cmap_calc.c(199)" + (mips-2 "name defined but never used: LinInt in cmap_calc.c(199)" 40 nil 199 "cmap_calc.c") ;; msft - ("keyboard handler.c(537) : warning C4005: 'min' : macro redefinition" + (msft "keyboard handler.c(537) : warning C4005: 'min' : macro redefinition" 1 nil 537 "keyboard handler.c") - ("d:\\tmp\\test.c(23) : error C2143: syntax error : missing ';' before 'if'" + (msft + "d:\\tmp\\test.c(23) : error C2143: syntax error : missing ';' before 'if'" 1 nil 23 "d:\\tmp\\test.c") - ("d:\\tmp\\test.c(1145) : see declaration of 'nsRefPtr'" + (msft "d:\\tmp\\test.c(1145) : see declaration of 'nsRefPtr'" 1 nil 1145 "d:\\tmp\\test.c") - ("1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'" + (msft "1>test_main.cpp(29): error C2144: syntax error : 'int' should be preceded by ';'" 3 nil 29 "test_main.cpp") - ("1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int" + (msft "1>test_main.cpp(29): error C4430: missing type specifier - int assumed. Note: C++ does not support default-int" 3 nil 29 "test_main.cpp") + (msft "C:\\tmp\\test.cpp(101,11): error C4101: 'bias0123': unreferenced local variable [C:\\tmp\\project.vcxproj]" + 1 11 101 "C:\\tmp\\test.cpp") ;; watcom - ("..\\src\\ctrl\\lister.c(109): Error! E1009: Expecting ';' but found '{'" + (watcom + "..\\src\\ctrl\\lister.c(109): Error! E1009: Expecting ';' but found '{'" 1 nil 109 "..\\src\\ctrl\\lister.c") - ("..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" + (watcom "..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" 1 nil 120 "..\\src\\ctrl\\lister.c") + ;; omake + ;; FIXME: This doesn't actually test the omake rule. + (gnu " alpha.c:5:15: error: expected ';' after expression" + 1 15 5 "alpha.c") ;; oracle - ("Semantic error at line 528, column 5, file erosacqdb.pc:" + (oracle "Semantic error at line 528, column 5, file erosacqdb.pc:" 1 5 528 "erosacqdb.pc") - ("Error at line 41, column 10 in file /usr/src/sb/ODBI_BHP.hpp" + (oracle "Error at line 41, column 10 in file /usr/src/sb/ODBI_BHP.hpp" 1 10 41 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-02150: error at line 49, column 27 in file /usr/src/sb/ODBI_dxfgh.pc" + (oracle + "PCC-02150: error at line 49, column 27 in file /usr/src/sb/ODBI_dxfgh.pc" 1 27 49 "/usr/src/sb/ODBI_dxfgh.pc") - ("PCC-00003: invalid SQL Identifier at column name in line 12 of file /usr/src/sb/ODBI_BHP.hpp" + (oracle "PCC-00003: invalid SQL Identifier at column name in line 12 of file /usr/src/sb/ODBI_BHP.hpp" 1 nil 12 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-00004: mismatched IF/ELSE/ENDIF block at line 27 in file /usr/src/sb/ODBI_BHP.hpp" + (oracle "PCC-00004: mismatched IF/ELSE/ENDIF block at line 27 in file /usr/src/sb/ODBI_BHP.hpp" 1 nil 27 "/usr/src/sb/ODBI_BHP.hpp") - ("PCC-02151: line 21 column 40 file /usr/src/sb/ODBI_BHP.hpp:" + (oracle "PCC-02151: line 21 column 40 file /usr/src/sb/ODBI_BHP.hpp:" 1 40 21 "/usr/src/sb/ODBI_BHP.hpp") ;; perl - ("syntax error at automake line 922, near \"':'\"" + (perl "syntax error at automake line 922, near \"':'\"" 14 nil 922 "automake") - ("Died at test.pl line 27." + (perl "Died at test.pl line 27." 6 nil 27 "test.pl") - ("store::odrecall('File_A', 'x2') called at store.pm line 90" + (perl "store::odrecall('File_A', 'x2') called at store.pm line 90" 40 nil 90 "store.pm") - ("\t(in cleanup) something bad at foo.pl line 3 during global destruction." + (perl + "\t(in cleanup) something bad at foo.pl line 3 during global destruction." 29 nil 3 "foo.pl") - ("GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3." + (perl "GLib-GObject-WARNING **: /build/buildd/glib2.0-2.14.5/gobject/gsignal.c:1741: instance `0x8206790' has no handler with id `1234' at t-compilation-perl-gtk.pl line 3." 130 nil 3 "t-compilation-perl-gtk.pl") ;; php - ("Parse error: parse error, unexpected $ in main.php on line 59" + (php "Parse error: parse error, unexpected $ in main.php on line 59" 1 nil 59 "main.php") - ("Fatal error: Call to undefined function: mysql_pconnect() in db.inc on line 66" + (php "Fatal error: Call to undefined function: mysql_pconnect() in db.inc on line 66" 1 nil 66 "db.inc") - ;; ruby - ("plain-exception.rb:7:in `fun': unhandled exception" + ;; ruby (uses gnu) + (gnu "plain-exception.rb:7:in `fun': unhandled exception" 1 nil 7 "plain-exception.rb") - ("\tfrom plain-exception.rb:3:in `proxy'" 2 nil 3 "plain-exception.rb") - ("\tfrom plain-exception.rb:12" 2 nil 12 "plain-exception.rb") + (gcc-include + "\tfrom plain-exception.rb:3:in `proxy'" 2 nil 3 "plain-exception.rb") + (gcc-include "\tfrom plain-exception.rb:12" 2 nil 12 "plain-exception.rb") ;; ruby-Test::Unit ;; FIXME - (" [examples/test-unit.rb:28:in `here_is_a_deep_assert'" + (ruby-Test::Unit " [examples/test-unit.rb:28:in `here_is_a_deep_assert'" 5 nil 28 "examples/test-unit.rb") - (" examples/test-unit.rb:19:in `test_a_deep_assert']:" + (ruby-Test::Unit " examples/test-unit.rb:19:in `test_a_deep_assert']:" 6 nil 19 "examples/test-unit.rb") - ("examples/test-unit.rb:10:in `test_assert_raise'" + (gnu "examples/test-unit.rb:10:in `test_assert_raise'" 1 nil 10 "examples/test-unit.rb") ;; rxp - ("Error: Mismatched end tag: expected </geroup>, got </group>\nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml" + (rxp "Error: Mismatched end tag: expected </geroup>, got </group>\nin unnamed entity at line 71 char 8 of file:///home/reto/test/group.xml" 1 8 71 "/home/reto/test/group.xml") - ("Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml" + (rxp "Warning: Start tag for undeclared element geroup\nin unnamed entity at line 4 char 8 of file:///home/reto/test/group.xml" 1 8 4 "/home/reto/test/group.xml") + ;; shellcheck + (shellcheck "In autogen.sh line 48:" + 1 nil 48 "autogen.sh") ;; sparc-pascal-file sparc-pascal-line sparc-pascal-example - ("Thu May 14 10:46:12 1992 mom3.p:" + (sparc-pascal-file "Thu May 14 10:46:12 1992 mom3.p:" 1 nil nil "mom3.p") ;; sun - ("cc-1020 CC: REMARK File = CUI_App.h, Line = 735" + (sun "cc-1020 CC: REMARK File = CUI_App.h, Line = 735" 13 nil 735 "CUI_App.h") - ("cc-1070 cc: WARNING File = linkl.c, Line = 38" + (sun "cc-1070 cc: WARNING File = linkl.c, Line = 38" 13 nil 38 "linkl.c") - ("cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3" + (sun "cf90-113 f90comp: ERROR NSE, File = Hoved.f90, Line = 16, Column = 3" 18 3 16 "Hoved.f90") ;; sun-ada - ("/home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: \",\" inserted" + (sun-ada "/home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: \",\" inserted" 1 6 361 "/home3/xdhar/rcds_rc/main.a") ;; 4bsd - ("/usr/src/foo/foo.c(8): warning: w may be used before set" + (edg-1 "/usr/src/foo/foo.c(8): warning: w may be used before set" 1 nil 8 "/usr/src/foo/foo.c") - ("/usr/src/foo/foo.c(9): error: w is used before set" + (edg-1 "/usr/src/foo/foo.c(9): error: w is used before set" 1 nil 9 "/usr/src/foo/foo.c") - ("strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)" + (4bsd "strcmp: variable # of args. llib-lc(359) :: /usr/src/foo/foo.c(8)" 44 nil 8 "/usr/src/foo/foo.c") - ("bloofle defined( /users/wolfgang/foo.c(4) ), but never used" + (4bsd "bloofle defined( /users/wolfgang/foo.c(4) ), but never used" 18 nil 4 "/users/wolfgang/foo.c") ;; perl--Pod::Checker ;; FIXME @@ -321,21 +397,21 @@ ;; *** ERROR: =over on line 37 without closing =back at line EOF in file bar.pm ;; *** ERROR: =over on line 1 without closing =back (at head1) at line 3 in file x.pod ;; perl--Test - ("# Failed test 1 in foo.t at line 6" + (perl--Test "# Failed test 1 in foo.t at line 6" 1 nil 6 "foo.t") ;; perl--Test::Harness - ("NOK 1# Test 1 got: \"1234\" (t/foo.t at line 46)" + (perl--Test2 "NOK 1# Test 1 got: \"1234\" (t/foo.t at line 46)" 1 nil 46 "t/foo.t") ;; weblint - ("index.html (13:1) Unknown element <fdjsk>" + (weblint "index.html (13:1) Unknown element <fdjsk>" 1 1 13 "index.html")) "List of tests for `compilation-error-regexp-alist'. -Each element has the form (STR POS COLUMN LINE FILENAME [TYPE]), -where STR is an error string, POS is the position of the error in -STR, COLUMN and LINE are the reported column and line numbers (or -nil) for that error, FILENAME is the reported filename, and TYPE -is 0 for an information message, 1 for a warning, and 2 for an -error. +Each element has the form (RULE STR POS COLUMN LINE FILENAME +[TYPE]), where RULE is the rule (as a symbol), STR is an error +string, POS is the position of the error in STR, COLUMN and LINE +are the reported column and line numbers (or nil) for that error, +FILENAME is the reported filename, and TYPE is 0 for an +information message, 1 for a warning, and 2 for an error. LINE can also be of the form (LINE . END-LINE) meaning a range of lines. COLUMN can also be of the form (COLUMN . END-COLUMN) @@ -343,40 +419,131 @@ meaning a range of columns starting on LINE and ending on END-LINE, if that matched. TYPE can be left out, in which case any message type is accepted.") +(defconst compile-tests--grep-regexp-testcases + ;; Bug#32051. + '((nil + "c:/Users/my.name/src/project\\src\\kbhit.hpp\0\ 29:#include <termios.h>" + 1 nil 29 "c:/Users/my.name/src/project\\src\\kbhit.hpp") + (nil + "d:/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" + 1 nil 214 "d:/gnu/emacs/branch/src/callproc.c") + (nil + "/gnu/emacs/branch/src/callproc.c\0\ 214:#ifdef DOS_NT" + 1 nil 214 "/gnu/emacs/branch/src/callproc.c")) + "List of tests for `grep-regexp-list'. +The format is the same as `compile-tests--test-regexps-data', but +the match is expected to be the same when NUL bytes are replaced +with colon.") + +(defconst compile-tests--grep-regexp-tricky-testcases + ;; Bug#7378. + '((nil + "./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0\0\ 42:some text" + 1 nil 42 "./x11-libs---nx/3.4.0:0:C.30253.1289557929.792611.C/nx-3.4.0.exheres-0") + (nil + "2011-08-31_11:57:03_1\0\ 7:Date: Wed, 31 Aug 2011 11:57:03 +0000" + 1 nil 7 "2011-08-31_11:57:03_1")) + "List of tricky tests for `grep-regexp-list'. +Same as `compile-tests--grep-regexp-testcases', but these cases +can only work with the NUL byte to disambiguate colons.") + (defun compile--test-error-line (test) - (erase-buffer) - (setq compilation-locs (make-hash-table)) - (insert (car test)) - (compilation-parse-errors (point-min) (point-max)) - (let ((msg (get-text-property (nth 1 test) 'compilation-message))) - (should msg) - (let ((loc (compilation--message->loc msg)) - (col (nth 2 test)) - (line (nth 3 test)) - (file (nth 4 test)) - (type (nth 5 test)) - end-col end-line) - (if (consp col) - (setq end-col (cdr col) col (car col))) - (if (consp line) - (setq end-line (cdr line) line (car line))) - (should (equal (compilation--loc->col loc) col)) - (should (equal (compilation--loc->line loc) line)) - (when file - (should (equal (caar (compilation--loc->file-struct loc)) file))) - (when end-col - (should (equal (car (cadr (nth 2 (compilation--loc->file-struct loc)))) - end-col))) - (should (equal (car (nth 2 (compilation--loc->file-struct loc))) - (or end-line line))) - (when type - (should (equal type (compilation--message->type msg))))))) + (ert-info ((format "%S" test) :prefix "testcase: ") + (erase-buffer) + (setq compilation-locs (make-hash-table)) + (let ((rule (nth 0 test)) + (str (nth 1 test)) + (pos (nth 2 test)) + (col (nth 3 test)) + (line (nth 4 test)) + (file (nth 5 test)) + (type (nth 6 test))) + (insert str) + (compilation-parse-errors (point-min) (point-max)) + (let ((msg (get-text-property pos 'compilation-message))) + (should msg) + (let ((loc (compilation--message->loc msg)) + end-col end-line) + (if (consp col) + (setq end-col (cdr col) col (car col))) + (if (consp line) + (setq end-line (cdr line) line (car line))) + (should (equal (compilation--loc->col loc) col)) + (should (equal (compilation--loc->line loc) line)) + (when file + (should (equal (caar (compilation--loc->file-struct loc)) file))) + (when end-col + ;; The computed END-COL is exclusive; subtract one to get the + ;; number in the error message. + (should (equal + (1- (car (cadr + (nth 2 (compilation--loc->file-struct loc))))) + end-col))) + (should (equal (car (nth 2 (compilation--loc->file-struct loc))) + (or end-line line))) + (when type + (should (equal type (compilation--message->type msg)))) + (should (equal rule (compilation--message->rule msg)))) + msg)))) (ert-deftest compile-test-error-regexps () "Test the `compilation-error-regexp-alist' regexps. The test data is in `compile-tests--test-regexps-data'." (with-temp-buffer (font-lock-mode -1) - (mapc #'compile--test-error-line compile-tests--test-regexps-data))) + (let ((compilation-num-errors-found 0) + (compilation-num-warnings-found 0) + (compilation-num-infos-found 0)) + (mapc #'compile--test-error-line compile-tests--test-regexps-data) + (should (eq compilation-num-errors-found 98)) + (should (eq compilation-num-warnings-found 35)) + (should (eq compilation-num-infos-found 28))))) + +(ert-deftest compile-test-grep-regexps () + "Test the `grep-regexp-alist' regexps. +The test data is in `compile-tests--grep-regexp-testcases'." + (with-temp-buffer + (grep-mode) + (setq buffer-read-only nil) + (font-lock-mode -1) + (dolist (testcase compile-tests--grep-regexp-testcases) + (let (msg1 msg2) + (setq msg1 (compile--test-error-line testcase)) + ;; Make sure replacing the NUL character with a colon still matches. + (let ((testcase2 (copy-sequence testcase))) + (setf (nth 1 testcase2) + (string-replace "\0" ":" (nth 1 testcase2))) + (setq msg2 (compile--test-error-line testcase2))) + (should (equal msg1 msg2)))) + (dolist (testcase compile-tests--grep-regexp-tricky-testcases) + (compile--test-error-line testcase)) + (should (eq compilation-num-errors-found 8)))) + +(ert-deftest compile-test-functions () + "Test rules using functions instead of regexp group numbers." + (let* ((file-fun (lambda () '("my-file"))) + (line-start-fun (lambda () 123)) + (line-end-fun (lambda () 134)) + (col-start-fun (lambda () 39)) + (col-end-fun (lambda () 24)) + (compilation-error-regexp-alist-alist + `((my-rule + ,(rx bol "My error message") + ,file-fun + (,line-start-fun . ,line-end-fun) + (,col-start-fun . ,col-end-fun)))) + (compilation-error-regexp-alist '(my-rule))) + (with-temp-buffer + (font-lock-mode -1) + (let ((compilation-num-errors-found 0) + (compilation-num-warnings-found 0) + (compilation-num-infos-found 0)) + (compile--test-error-line + '(my-rule + "My error message" + 1 (39 . 24) (123 . 134) "my-file" 2)) + (should (eq compilation-num-errors-found 1)) + (should (eq compilation-num-warnings-found 0)) + (should (eq compilation-num-infos-found 0)))))) ;;; compile-tests.el ends here 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-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-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 +{<?xml version="1.0" encoding="UTF-8"?> +<kml xmlns="http://www.opengis.net/kml/2.2"> + <Document> + <Folder><name>台灣 %s 廣播電台</name> + <description><![CDATA[http://radioscanningtw.wikia.com/wiki/台描:地圖 %d-%02d-%02d]]></description> +}, uc( substr( $ARGV[0], 0, 2 ) ), $year + 1900, $mon + 1, $mday; 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-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{<div class="clearfix">}); +my $bad = XML::LibXML->load_xml( string =>q{<div class="clearfix">}); + +# 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-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\.</ + || / like[ds]? your post in </ + || /like[ds] your new subscription\. </ + || / likes? that you're interested in </ + || /> likes? your comment: / + || /&birthdays=.*birthdays?\.<\/a>/; +} + +sub boring { + return + / likes? your post in </ + || / likes? that you're interested in </ +} 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-resources/cperl-indent-exp.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl new file mode 100644 index 00000000000..8c1883a10f1 --- /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; +} +} +# -------- while loop: expected output -------- +{ + while (1) { + say "boring loop"; + } continue { + last; + } +} +# -------- 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 -------- 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..371b19b7309 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-styles.pl @@ -0,0 +1,54 @@ +#!/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 -------- + +# -------- 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-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-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-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl new file mode 100644 index 00000000000..96a86993082 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl @@ -0,0 +1,172 @@ +use 5.024; +use strict; +use warnings; +use utf8; + +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(); + +# 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 new file mode 100644 index 00000000000..bb3d4871a91 --- /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 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 +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 = <<HERE +look-here +HERE + +. 'indent-level'; # Continuation, should be indented + +=head2 Test case 3 + +A here document with a line-end comment in the starter line, +after a complete statement + +=cut + +## test case + +$text = <<HERE; # start here +look-here +HERE + +$noindent = "New statement in this line"; + +=head2 Test case 4 + +A HERE document with a to-be-continued statement and a comment in the +starter line. + +=cut + +## test case + +$text = <<HERE # start here +look-here +HERE + +. 'indent-level'; # Continuation, should be indented + +=head2 Test case 5 + +A HERE document with a comment sign, but no comment to follow. + + +=cut + +## test case + +$text = <<HERE; # +look-here +HERE + +$noindent = "New statement in this line"; + +=head2 Test case 6 + +A HERE document with a comment sign, but no comment to follow, with a +statement to be continued. Also, the character before the comment +sign has a relevant syntax property (end of string in our case) which +must be preserved. + +=cut + +## test case + +$text = <<"HERE"# +look-here +HERE + +. 'indent-level'; # Continuation, should be indented + +__END__ 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 new file mode 100644 index 00000000000..1bb206e7040 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -0,0 +1,1151 @@ +;;; cperl-mode-tests.el --- Test for cperl-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc. + +;; Author: Harald Jörg <haj@posteo.de> +;; Maintainer: Harald Jörg +;; Keywords: internal +;; URL: https://github.com/HaraldJoerg/cperl-mode + +;; 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: + +;; This is a collection of tests for CPerl-mode. + +;;; Code: + +(defvar cperl-test-mode #'cperl-mode) + +(require 'cperl-mode) +(require 'ert) +(require 'ert-x) + +;;; Utilities + +(defun cperl-test-ppss (text regexp) + "Return the `syntax-ppss' after the last character matched by REGEXP in TEXT." + (interactive) + (with-temp-buffer + (insert text) + (funcall cperl-test-mode) + (goto-char (point-min)) + (re-search-forward regexp) + (syntax-ppss))) + +(defmacro cperl--run-test-cases (file &rest body) + "Run all test cases in FILE with BODY. +This macro helps with tests which reformat Perl code, e.g. when +indenting or rearranging flow control. It extracts source code +snippets and corresponding expected results from a resource file, +runs BODY on the snippets, and compares the resulting buffer with +the expected results. + +Test cases in FILE are formatted like this: + +# -------- NAME: input -------- +Your input to the test case comes here. +Both input and expected output may span several lines. +# -------- NAME: expected output -------- +The expected output from running BODY on the input goes here. +# -------- NAME: end -------- + +You can have many of these blocks in one test file. You can +chose a NAME for each block, which is passed to the `should' +clause for easy identification of the first test case that +failed (if any). Text outside these the blocks is ignored by the +tests, so you can use it to document the test cases if you wish." + `(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) + (goto-char (point-min)) + (funcall cperl-test-mode) + ,@body + (setq expected (concat "test case " name ":\n" expected)) + (setq got (concat "test case " name ":\n" (buffer-string))) + (should (equal got expected))))))) + +;;; Indentation tests + +(ert-deftest cperl-test-indent-exp () + "Run various tests for `cperl-indent-exp' edge cases. +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)) + (cperl--run-test-cases + (ert-resource-file "cperl-indent-exp.pl") + (cperl-indent-exp))) ; here we go! + +(ert-deftest cperl-test-indent-styles () + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (cperl--run-test-cases + (ert-resource-file "cperl-indent-styles.pl") + (cperl-set-style "PBP") + (indent-region (point-min) (point-max)) ; here we go! + (cperl-set-style-back))) + +;;; Fontification tests + +(ert-deftest cperl-test-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)))))) + +(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)))) + +(ert-deftest cperl-test-fontify-attrs-and-signatures () + "Test fontification of the various combinations of subroutine +attributes, prototypes and signatures." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((file (ert-resource-file "proto-and-attrs.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + + ;; Named subroutines + (while (search-forward-regexp "\\_<sub_[[:digit:]]+" nil t) + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-function-name-face)) + (let ((start-of-sub (match-beginning 0)) + (end-of-sub (save-excursion (search-forward "}") (point)))) + + ;; Prototypes are shown as strings + (when (search-forward-regexp " ([$%@*]*) " end-of-sub t) + (should (equal (get-text-property (1+ (match-beginning 0)) 'face) + 'font-lock-string-face))) + (goto-char start-of-sub) + (when (search-forward-regexp "\\(:[a-z]+\\)\\((.*?)\\)?" end-of-sub t) + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-constant-face)) + (when (match-beginning 2) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-string-face)))) + (goto-char end-of-sub))) + + ;; Anonymous subroutines + (while (search-forward-regexp "= sub" nil t) + (let ((start-of-sub (match-beginning 0)) + (end-of-sub (save-excursion (search-forward "}") (point)))) + + ;; Prototypes are shown as strings + (when (search-forward-regexp " ([$%@*]*) " end-of-sub t) + (should (equal (get-text-property (1+ (match-beginning 0)) 'face) + 'font-lock-string-face))) + (goto-char start-of-sub) + (when (search-forward-regexp "\\(:[a-z]+\\)\\((.*?)\\)?" end-of-sub t) + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-constant-face)) + (when (match-beginning 2) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-string-face)))) + (goto-char end-of-sub)))))) + +(ert-deftest cperl-test-fontify-special-variables () + "Test fontification of variables like $^T or ${^ENCODING}. +These can occur as \"local\" aliases." + (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) + (case-fold-search nil)) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (indent-region (point-min) (point-max)) + (font-lock-ensure (point-min) (point-max)) + (while (search-forward "## test case" nil t) + (save-excursion + (while (search-forward "look-here" nil t) + (should (equal + (get-text-property (match-beginning 0) 'face) + cperl--tests-heredoc-face)) + (beginning-of-line) + (should (null (looking-at "[ \t]"))) + (forward-line 1))) + (should (re-search-forward + (concat "^\\([ \t]*\\)" ; the actual indentation amount + "\\([^ \t\n].*?\\)\\(no\\)?indent") + nil t)) + (should (equal (- (match-end 1) (match-beginning 1)) + (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-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 (rx (eval cperl--ws-rx)) + valid invalid))) + +(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 (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")) + (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." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (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 (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 () + "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" + "Erdős::Number::erdős_number"))) + (dolist (sub expected) + (should (assoc-string sub index))))))) + +;;; Tests for issues reported in the Bug Tracker + +(ert-deftest cperl-test-bug-997 () + "Test that we distinguish a regexp match when there's nothing before it." + (let ((code "# some comment\n\n/fontify me/;\n")) + (with-temp-buffer + (funcall cperl-test-mode) + (insert code) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "/f") + (should (equal (get-text-property (point) 'face) + 'font-lock-string-face))))) + +(defun cperl-test--run-bug-10483 () + "Runs a short program, intended to be under timer scrutiny. +This function is intended to be used by an Emacs subprocess in +batch mode. The message buffer is used to report the result of +running `cperl-indent-exp' for a very simple input. The result +is expected to be different from the input, to verify that +indentation actually takes place.." + (let ((code "poop ('foo', \n'bar')")) ; see the bug report + (message "Test Bug#10483 started") + (with-temp-buffer + (insert code) + (funcall cperl-test-mode) + (goto-char (point-min)) + (search-forward "poop") + (cperl-indent-exp) + (message "%s" (buffer-string))))) + +(ert-deftest cperl-test-bug-10483 () + "Check that indenting certain perl code does not loop forever. +This verifies that indenting a piece of code that ends in a paren +without a statement terminator on the same line does not loop +forever. The test starts an asynchronous Emacs batch process +under timeout control." + :tags '(:expensive-test) + (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out + (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let* ((emacs (concat invocation-directory invocation-name)) + (test-function 'cperl-test--run-bug-10483) + (test-function-name (symbol-name test-function)) + (test-file (symbol-file test-function 'defun)) + (ran-out-of-time nil) + (process-connection-type nil) + runner) + (with-temp-buffer + (with-timeout (2 + (delete-process runner) + (setq ran-out-of-time t)) + (setq runner (start-process "speedy" + (current-buffer) + emacs + "-batch" + "--quick" + "--load" test-file + "--funcall" test-function-name)) + (while (accept-process-output runner))) + (should (equal ran-out-of-time nil)) + (goto-char (point-min)) + ;; just a very simple test for indentation: This should + ;; be rather robust with regard to indentation defaults + (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." + (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)) + (let ((code "/(\\d{4})(?{2}/;") ; the regex from the bug report + (result)) + (with-temp-buffer + (insert code) + (goto-char 9) + (setq result (cperl-forward-group-in-re)) + (should (equal (car result) 'scan-error)) + (should (equal (nth 1 result) "Unbalanced parentheses")) + (should (= (point) 9)))) ; point remains unchanged on error + (let ((code "/(\\d{4})(?{2})/;") ; here all parens are balanced + (result)) + (with-temp-buffer + (insert code) + (goto-char 9) + (setq result (cperl-forward-group-in-re)) + (should (equal result nil)) + (should (= (point) 15))))) ; point has skipped the group + +(ert-deftest cperl-test-bug-19709 () + "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." + (cperl--run-test-cases + (ert-resource-file "cperl-bug-19709.pl") + ;; settings from the bug report + (setq-local cperl-indent-level 4) + (setq-local cperl-indent-parens-as-block t) + (setq-local cperl-close-paren-offset -4) + ;; same, adapted for per-mode + (setq-local perl-indent-level 4) + (setq-local perl-indent-parens-as-block t) + (while (null (eobp)) + (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 +text in regular expressions, which is non-nil for both cperl-mode +and perl-mode." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-26850.pl")) + (goto-char (point-min)) + (re-search-forward "sub interesting {[^}]*}") + (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "Today")) + nil)) + (re-search-forward "sub boring {[^}]*}") + (should-not (equal (nth 3 (cperl-test-ppss (match-string 0) "likes\\?")) + nil)))) + +(ert-deftest cperl-test-bug-30393 () + "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." + (cperl--run-test-cases + (ert-resource-file "cperl-bug-30393.pl") + (while (null (eobp)) + (cperl-indent-command) + (forward-line 1)))) + +(ert-deftest cperl-test-bug-37127 () + "Verify that closing a paren in a regex goes without a message. +Also check that the message is issued if the regex terminator is +missing." + ;; The actual fix for this bug is in simple.el, which is not + ;; backported to older versions of Emacs. Therefore we skip this + ;; test if we're running Emacs 27 or older. + (skip-unless (< 27 emacs-major-version)) + ;; Part one: Regex is ok, no messages + (ert-with-message-capture collected-messages + (with-temp-buffer + (insert "$_ =~ /(./;") + (funcall cperl-test-mode) + (goto-char (point-min)) + (search-forward ".") + (let ((last-command-event ?\)) + ;; Don't emit "Matches ..." even if not visible (e.g. in batch). + (blink-matching-paren 'jump-offscreen)) + (self-insert-command 1) + ;; `self-insert-command' doesn't call `blink-matching-open' in + ;; batch mode, so we need to call it explicitly. + (blink-matching-open)) + (syntax-propertize (point-max))) + (should (string-equal collected-messages ""))) + ;; part two: Regex terminator missing -> message + (when (eq cperl-test-mode #'cperl-mode) + ;; This test is only run in `cperl-mode' because only cperl-mode + ;; emits a message to warn about such unclosed REs. + (ert-with-message-capture collected-messages + (with-temp-buffer + (insert "$_ =~ /(..;") + (goto-char (point-min)) + (funcall cperl-test-mode) + (search-forward ".") + (let ((last-command-event ?\))) + (self-insert-command 1)) + (syntax-propertize (point-max))) + (should (string-match "^End of .* string/RE" + collected-messages))))) + +(ert-deftest cperl-test-bug-42168 () + "Verify that '/' is a division after ++ or --, not a regexp. +Reported in https://github.com/jrockway/cperl-mode/issues/45. +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. 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 slash + ;; starts a string. + (let ((code "{ $a+ / $b } # /")) + (should (equal (nth 8 (cperl-test-ppss code "/")) 7))) + (let ((code "{ $a- / $b } # /")) + (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))) + +(ert-deftest cperl-test-bug-45255 () + "Verify that \"<<>>\" is recognized as not starting a HERE-doc." + (let ((code (concat "while (<<>>) {\n" + " ...;\n" + "}\n"))) + ;; 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))))) + +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) + +;;; cperl-mode-tests.el ends here 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 a6c64edeb7f..e73be0db504 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -1,6 +1,6 @@ ;;; elisp-mode-tests.el --- Tests for emacs-lisp-mode -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2017 Free Software Foundation, Inc. +;; Copyright (C) 2015-2022 Free Software Foundation, Inc. ;; Author: Dmitry Gutov <dgutov@yandex.ru> ;; Author: Stephen Leake <stephen_leake@member.fsf.org> @@ -23,8 +23,10 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'xref) (eval-when-compile (require 'cl-lib)) +(require 'ert-x) ;;; Completion @@ -107,7 +109,7 @@ (should (member "backup-inhibited" comps)) (should-not (member "backup-buffer" comps)))))) -(ert-deftest elisp-completes-functions-after-let-bindings () +(ert-deftest elisp-completes-functions-after-let-bindings-2 () (with-temp-buffer (emacs-lisp-mode) (insert "(let ((bar 1) (baz 2)) (ba") @@ -181,6 +183,16 @@ (call-interactively #'eval-last-sexp) (should (equal (current-message) "66 (#o102, #x42, ?B)")))))) +;;; eval-defun + +(ert-deftest eval-defun-prints-edebug-when-instrumented () + (skip-unless (not noninteractive)) + (with-temp-buffer + (let ((current-prefix-arg '(4))) + (erase-buffer) (insert "(defun foo ())") (message nil) + (call-interactively #'eval-defun) + (should (equal (current-message) "Edebug: foo"))))) + ;;; eldoc (defun elisp-mode-tests--face-propertized-string (string) @@ -194,7 +206,7 @@ (dotimes (i 3) (should (equal (elisp-mode-tests--face-propertized-string - (elisp--highlight-function-argument 'foo "(A B C)" (1+ i) "foo: ")) + (elisp--highlight-function-argument 'foo "(A B C)" (1+ i))) (propertize (nth i '("A" "B" "C")) 'face 'eldoc-highlight-function-argument))))) @@ -206,7 +218,7 @@ (cl-flet ((bold-arg (i) (elisp-mode-tests--face-propertized-string (elisp--highlight-function-argument - 'foo "(PROMPT LST &key A B C)" i "foo: ")))) + 'foo "(PROMPT LST &key A B C)" i)))) (should-not (bold-arg 0)) (progn (forward-sexp) (forward-char)) (should (equal (bold-arg 1) "PROMPT")) @@ -226,7 +238,7 @@ (cl-flet ((bold-arg (i) (elisp-mode-tests--face-propertized-string (elisp--highlight-function-argument - 'foo "(X &key A B C)" i "foo: ")))) + 'foo "(X &key A B C)" i)))) (should-not (bold-arg 0)) ;; The `:b' specifies positional arg `X'. (progn (forward-sexp) (forward-char)) @@ -298,20 +310,41 @@ ))) +;; tmp may be on a different filesystem to the tests, but, ehh. +(defvar xref--case-insensitive + (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) (should (= (length xrefs) (length expected-xrefs))) (while xrefs (let* ((xref (pop xrefs)) (expected (pop expected-xrefs)) (expected-xref (or (when (consp expected) (car expected)) expected)) - (expected-source (when (consp expected) (cdr expected)))) + (expected-source (when (consp expected) (cdr expected))) + (xref-file (xref-elisp-location-file (xref-item-location xref))) + (expected-file (xref-elisp-location-file + (xref-item-location expected-xref)))) + + ;; Make sure file names compare as strings. + (when (file-name-absolute-p xref-file) + (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 (xref-item-location expected-xref)) + (file-truename (xref-elisp-location-file + (xref-item-location expected-xref))))) ;; Downcase the filenames for case-insensitive file systems. - (setf (xref-elisp-location-file (oref xref location)) - (downcase (xref-elisp-location-file (oref xref location)))) + (when xref--case-insensitive + (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)) - (downcase (xref-elisp-location-file (oref expected-xref location)))) + (setf (xref-elisp-location-file (xref-item-location expected-xref)) + (downcase (xref-elisp-location-file + (xref-item-location expected-xref))))) (should (equal xref expected-xref)) @@ -346,10 +379,10 @@ to (xref-elisp-test-descr-to-target xref)." ;; `load-path' has the correct case, so this causes the expected test ;; values to have the wrong case). This is handled in ;; `xref-elisp-test-run'. -(defconst emacs-test-dir - (downcase - (file-truename (file-name-directory - (or load-file-name (buffer-file-name)))))) +(defvar emacs-test-dir + (funcall (if xref--case-insensitive 'downcase 'identity) + (file-truename (file-name-directory + (or load-file-name (buffer-file-name)))))) ;; alphabetical by test name @@ -374,23 +407,24 @@ to (xref-elisp-test-descr-to-target xref)." "(cl-defstruct (xref-elisp-location") )) +(require 'em-xtra) +(require 'find-dired) (xref-elisp-deftest find-defs-defalias-defun-el - (elisp--xref-find-definitions 'Buffer-menu-sort) + (elisp--xref-find-definitions 'eshell/ff) (list - (xref-make "(defalias Buffer-menu-sort)" + (xref-make "(defalias eshell/ff)" (xref-make-elisp-location - 'Buffer-menu-sort 'defalias - (expand-file-name "../../../lisp/buff-menu.elc" emacs-test-dir))) - (xref-make "(defun tabulated-list-sort)" + 'eshell/ff 'defalias + (expand-file-name "../../../lisp/eshell/em-xtra.elc" + emacs-test-dir))) + (xref-make "(defun find-name-dired)" (xref-make-elisp-location - 'tabulated-list-sort nil - (expand-file-name "../../../lisp/emacs-lisp/tabulated-list.el" emacs-test-dir))) - )) + 'find-name-dired nil + (expand-file-name "../../../lisp/find-dired.el" + emacs-test-dir))))) ;; 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. @@ -402,7 +436,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 ) @@ -413,45 +447,52 @@ 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" - "non-default for no-default") + "Doc string generic no-default xref-elisp-root-type." + "non-default for no-default" + (list this arg2)) ; silence byte-compiler ;; 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" - "co-located default") +(with-no-warnings ; FIXME: Make more specific. + (cl-defgeneric xref-elisp-generic-co-located-default (arg1 arg2) + "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" - "non-default for co-located-default") +(with-no-warnings ; FIXME: Make more specific. + (cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type) arg2) + "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" - "separate default") + "Doc string generic separate-default default." + "separate default" + (list arg1 arg2)) ; silence byte-compiler (cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type) arg2) - "doc string generic separate-default xref-elisp-root-type" - "non-default for separate-default") + "Doc string generic separate-default xref-elisp-root-type." + "non-default for separate-default" + (list this arg2)) ; silence byte-compiler (cl-defmethod xref-elisp-generic-implicit-generic (arg1 arg2) - "doc string generic implicit-generic default" - "default for implicit generic") + "Doc string generic implicit-generic default." + "default for implicit generic" + (list arg1 arg2)) ; silence byte-compiler (cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type) arg2) - "doc string generic implicit-generic xref-elisp-root-type" - "non-default for implicit generic") + "Doc string generic implicit-generic xref-elisp-root-type." + "non-default for implicit generic" + (list this arg2)) ; silence byte-compiler (xref-elisp-deftest find-defs-defgeneric-no-methods @@ -577,47 +618,54 @@ 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 - (elisp--xref-find-definitions (eval '(cl-defgeneric stephe-leake-cl-defgeneric ()))) + (elisp--xref-find-definitions (eval '(cl-defgeneric stephe-leake-cl-defgeneric ()) t)) nil) ;; Define some mode-local overloadable/overridden functions for xref to find (require 'mode-local) +(declare-function xref-elisp-overloadable-no-methods-default "elisp-mode-tests") +(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.") -;; FIXME: byte compiler complains about unused lexical arguments -;; generated by this macro. (define-mode-local-override xref-elisp-overloadable-no-default c-mode - (start end &optional nonterminal depth returnonerror) - "doc string overloadable no-default c-mode." + (_start _end &optional _nonterminal _depth _returnonerror) + "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." + (_start _end &optional _nonterminal _depth _returnonerror) + "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." + (_start _end &optional _nonterminal _depth _returnonerror) + "Doc string overloadable separate-default c-mode." "result overloadable separate-default c-mode.") (xref-elisp-deftest find-defs-define-overload-no-methods @@ -681,7 +729,7 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))))) (xref-elisp-deftest find-defs-defun-eval - (elisp--xref-find-definitions (eval '(defun stephe-leake-defun ()))) + (elisp--xref-find-definitions (eval '(defun stephe-leake-defun ()) t)) nil) (xref-elisp-deftest find-defs-defun-c @@ -718,15 +766,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)" @@ -736,12 +780,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))) )) @@ -755,7 +814,7 @@ to (xref-elisp-test-descr-to-target xref)." "DEFVAR_PER_BUFFER (\"default-directory\""))) (xref-elisp-deftest find-defs-defvar-eval - (elisp--xref-find-definitions (eval '(defvar stephe-leake-defvar nil))) + (elisp--xref-find-definitions (eval '(defvar stephe-leake-defvar nil) t)) nil) (xref-elisp-deftest find-defs-face-el @@ -773,7 +832,7 @@ to (xref-elisp-test-descr-to-target xref)." )) (xref-elisp-deftest find-defs-face-eval - (elisp--xref-find-definitions (eval '(defface stephe-leake-defface nil ""))) + (elisp--xref-find-definitions (eval '(defface stephe-leake-defface nil "") t)) nil) (xref-elisp-deftest find-defs-feature-el @@ -788,7 +847,7 @@ to (xref-elisp-test-descr-to-target xref)." )) (xref-elisp-deftest find-defs-feature-eval - (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature))) + (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature) t)) nil) (ert-deftest elisp--preceding-sexp--char-name () @@ -797,5 +856,275 @@ to (xref-elisp-test-descr-to-target xref)." (insert "?\\N{HEAVY CHECK MARK}") (should (equal (elisp--preceding-sexp) ?\N{HEAVY CHECK MARK})))) +(defun test--font (form search) + (with-temp-buffer + (emacs-lisp-mode) + (if (stringp form) + (insert form) + (pp form (current-buffer))) + (with-suppressed-warnings ((interactive-only font-lock-debug-fontify)) + (font-lock-debug-fontify)) + (goto-char (point-min)) + (and (re-search-forward search nil t) + (get-text-property (match-beginning 1) 'face)))) + +(ert-deftest test-elisp-font-keywords-1 () + ;; Special form. + (should (eq (test--font '(if foo bar) "(\\(if\\)") + 'font-lock-keyword-face)) + ;; Macro. + (should (eq (test--font '(when foo bar) "(\\(when\\)") + 'font-lock-keyword-face)) + (should (eq (test--font '(condition-case nil + (foo) + (error (if a b))) + "(\\(if\\)") + 'font-lock-keyword-face)) + (should (eq (test--font '(condition-case nil + (foo) + (when (if a b))) + "(\\(when\\)") + 'nil))) + +(ert-deftest test-elisp-font-keywords-2 () + (should (eq (test--font '(condition-case nil + (foo) + (error (when a b))) + "(\\(when\\)") + 'font-lock-keyword-face))) + +(ert-deftest test-elisp-font-keywords-3 () + (should (eq (test--font '(setq a '(if when zot)) + "(\\(if\\)") + nil))) + +(ert-deftest test-elisp-font-keywords-4 () + :expected-result :failed ; FIXME bug#43265 + (should (eq (test--font '(condition-case nil + (foo) + ((if foo) (when a b))) + "(\\(if\\)") + nil))) + +(ert-deftest test-elisp-font-keywords-5 () + (should (eq (test--font '(condition-case (when a) + (foo) + (error t)) + "(\\(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" (pos-eol) 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 f8393317611..673c582cc7a 100644 --- a/test/lisp/progmodes/etags-tests.el +++ b/test/lisp/progmodes/etags-tests.el @@ -1,6 +1,6 @@ -;;; etags-tests.el --- Test suite for etags.el. +;;; etags-tests.el --- Test suite for etags.el. -*- lexical-binding:t -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2022 Free Software Foundation, Inc. ;; Author: Eli Zaretskii <eliz@gnu.org> @@ -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/executable-tests.el b/test/lisp/progmodes/executable-tests.el new file mode 100644 index 00000000000..6988fef87de --- /dev/null +++ b/test/lisp/progmodes/executable-tests.el @@ -0,0 +1,51 @@ +;;; executable-tests.el --- Tests for executable.el -*- lexical-binding:t -*- + +;; Copyright (C) 2021-2022 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 'ert) +(require 'executable) + +(ert-deftest executable-tests-set-magic () + (with-temp-buffer + (insert "#!/foo/bar") + (executable-set-magic "/bin/bash" nil t t) + (should (equal (buffer-string) "#!/bin/bash")))) + +(ert-deftest executable-tests-set-magic/with-argument () + (with-temp-buffer + (insert "#!/foo/bar") + (executable-set-magic "/bin/bash" "--norc" t t) + (should (equal (buffer-string) "#!/bin/bash --norc")))) + +(ert-deftest executable-tests-set-magic/executable-insert-nil () + (let ((executable-insert nil)) + (with-temp-buffer + (insert "#!/foo/bar") + (executable-set-magic "/bin/bash" nil t nil) + (should (equal (buffer-string) "#!/foo/bar")))) + (let ((executable-insert nil)) + (with-temp-buffer + (insert "#!/foo/bar") + (executable-set-magic "/bin/bash" nil t t) + (should (equal (buffer-string) "#!/bin/bash"))))) + +;;; executable-tests.el ends here diff --git a/test/lisp/progmodes/f90-tests.el b/test/lisp/progmodes/f90-tests.el index 0c03a190ca2..b857a25bf2a 100644 --- a/test/lisp/progmodes/f90-tests.el +++ b/test/lisp/progmodes/f90-tests.el @@ -1,8 +1,9 @@ -;;; f90-tests.el --- tests for progmodes/f90.el +;;; f90-tests.el --- tests for progmodes/f90.el -*- lexical-binding:t -*- -;; Copyright (C) 2011-2017 Free Software Foundation, Inc. +;; Copyright (C) 2011-2022 Free Software Foundation, Inc. ;; Author: Glenn Morris <rgm@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; This file is part of GNU Emacs. @@ -21,9 +22,6 @@ ;;; Commentary: -;; This file does not have "test" in the name, because it lives under -;; a test/ directory, so that would be superfluous. - ;;; Code: (require 'ert) @@ -98,7 +96,7 @@ end subroutine test") (insert "(/ x /)") (f90-do-auto-fill) (beginning-of-line) - (skip-chars-forward "[ \t]") + (skip-chars-forward " \t") (should (equal "&(/" (buffer-substring (point) (+ 3 (point))))))) ;; TODO bug#5593 @@ -256,21 +254,45 @@ end program prog") (should (= 5 (current-indentation))))) (ert-deftest f90-test-bug25039 () - "Test for https://debbugs.gnu.org/25039 ." + "Test for https://debbugs.gnu.org/25039 and 28786." (with-temp-buffer (f90-mode) (insert "program prog select type (a) -class is (c1) -x = 1 type is (t1) x = 2 +class is (c1) +x = 1 +class default +x=3 end select end program prog") (f90-indent-subprogram) (forward-line -3) - (should (= 2 (current-indentation))) ; type is + (should (= 2 (current-indentation))) ; class default + (forward-line -2) + (should (= 2 (current-indentation))) ; class is (forward-line -2) - (should (= 2 (current-indentation))))) ; class is + (should (= 2 (current-indentation))))) ; type is + +(ert-deftest f90-test-bug38415 () + "Test for https://debbugs.gnu.org/38415 ." + (with-temp-buffer + (f90-mode) + (setq-local f90-smart-end 'no-blink) + (insert "module function foo(x) +real :: x +end") + (f90-indent-line) + (should (equal " function foo" + (buffer-substring (point) (pos-eol)))) + (goto-char (point-max)) + (insert "\nmodule subroutine bar(x) +real :: x +end") + (f90-indent-line) + (should (equal " subroutine bar" + (buffer-substring (point) (pos-eol)))))) + ;;; f90-tests.el ends here diff --git a/test/lisp/progmodes/flymake-resources/Makefile b/test/lisp/progmodes/flymake-resources/Makefile index 0f3f39791c8..05399ba388b 100644 --- a/test/lisp/progmodes/flymake-resources/Makefile +++ b/test/lisp/progmodes/flymake-resources/Makefile @@ -1,6 +1,6 @@ # Makefile for flymake tests -CC_OPTS = -Wall +CC_OPTS = -Wall -Wextra ## Recent gcc (e.g. 4.8.2 on RHEL7) can automatically colorize their output, ## which can confuse flymake. Set GCC_COLORS to disable that. @@ -8,6 +8,6 @@ CC_OPTS = -Wall ## normally use flymake, so it seems like just avoiding the issue ## in this test is fine. Set flymake-log-level to 3 to investigate. check-syntax: - GCC_COLORS= $(CC) $(CC_OPTS) ${CHK_SOURCES} + GCC_COLORS= gcc $(CC_OPTS) ${CHK_SOURCES} || true # eof 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/errors-and-warnings.c b/test/lisp/progmodes/flymake-resources/errors-and-warnings.c new file mode 100644 index 00000000000..1d38bd6bd27 --- /dev/null +++ b/test/lisp/progmodes/flymake-resources/errors-and-warnings.c @@ -0,0 +1,13 @@ +/* Flymake should notice an error on the next line, since + that file has at least one warning.*/ +#include "some-problems.h" +/* But not this one */ +#include "no-problems.h" + +int main() +{ + char c = 1000; /* a note and a warning */ + int bla; + char c; if (bla == (void*)3); /* an error, and two warnings */ + return c; +} diff --git a/test/lisp/progmodes/flymake-resources/no-problems.h b/test/lisp/progmodes/flymake-resources/no-problems.h new file mode 100644 index 00000000000..19ddc615b32 --- /dev/null +++ b/test/lisp/progmodes/flymake-resources/no-problems.h @@ -0,0 +1 @@ +typedef int no_problems; diff --git a/test/lisp/progmodes/flymake-resources/some-problems.h b/test/lisp/progmodes/flymake-resources/some-problems.h new file mode 100644 index 00000000000..86ea2de3b0d --- /dev/null +++ b/test/lisp/progmodes/flymake-resources/some-problems.h @@ -0,0 +1,7 @@ +#include <stdio.h> + +strange; + +int frob(char); + +sint main(); diff --git a/test/lisp/progmodes/flymake-resources/test.pl b/test/lisp/progmodes/flymake-resources/test.pl index d5abcb47e7f..6f4f1ccef50 100644 --- a/test/lisp/progmodes/flymake-resources/test.pl +++ b/test/lisp/progmodes/flymake-resources/test.pl @@ -1,2 +1,4 @@ @arr = [1,2,3,4]; +unknown; my $b = @arr[1]; +[ diff --git a/test/lisp/progmodes/flymake-resources/test.rb b/test/lisp/progmodes/flymake-resources/test.rb new file mode 100644 index 00000000000..1419eaf3ad2 --- /dev/null +++ b/test/lisp/progmodes/flymake-resources/test.rb @@ -0,0 +1,5 @@ +def bla + return 2 + print "not reached" + something + oops diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index b04346fd97c..71b03b21e5c 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -1,6 +1,6 @@ -;;; flymake-tests.el --- Test suite for flymake +;;; flymake-tests.el --- Test suite for flymake -*- lexical-binding: t -*- -;; Copyright (C) 2011-2017 Free Software Foundation, Inc. +;; Copyright (C) 2011-2022 Free Software Foundation, Inc. ;; Author: Eduard Wiebe <usenet@pusto.de> @@ -23,58 +23,358 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'flymake) +(eval-when-compile (require 'subr-x)) ; string-trim (defvar flymake-tests-data-directory - (expand-file-name "lisp/progmodes/flymake-resources" (getenv "EMACS_TEST_DIRECTORY")) + (expand-file-name "lisp/progmodes/flymake-resources" + (or (getenv "EMACS_TEST_DIRECTORY") + (expand-file-name "../../.." + (or load-file-name + buffer-file-name)))) "Directory containing flymake test data.") -;; Warning predicate -(defun flymake-tests--current-face (file predicate) - (let ((buffer (find-file-noselect - (expand-file-name file flymake-tests-data-directory))) - (process-environment (cons "LC_ALL=C" process-environment)) - (i 0)) +;; +;; +(defun flymake-tests--wait-for-backends () + ;; Weirdness here... https://debbugs.gnu.org/17647#25 + ;; ... meaning `sleep-for', and even + ;; `accept-process-output', won't suffice as ways to get + ;; process filters and sentinels to run, though they do work + ;; fine in a non-interactive batch session. The only thing + ;; that will indeed unblock pending process output is + ;; reading an input event, so, as a workaround, use a dummy + ;; `read-event' with a very short timeout. + (unless noninteractive (read-event "" nil 0.1)) + (cl-loop repeat 5 + for notdone = (cl-set-difference (flymake-running-backends) + (flymake-reporting-backends)) + while notdone + unless noninteractive do (read-event "" nil 0.1) + do (sleep-for (+ 0.5 (or flymake-no-changes-timeout 0))) + finally (when notdone (ert-skip + (format "Some backends not reporting yet %s" + notdone))))) + +(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'. +SEVERITY-PREDICATE is used to setup +`flymake-proc-diagnostic-type-pred'" + (let* ((file (expand-file-name file flymake-tests-data-directory)) + (visiting (find-buffer-visiting file)) + (buffer (or visiting (find-file-noselect file))) + (process-environment (cons "LC_ALL=C" process-environment)) + (warning-minimum-log-level :error)) (unwind-protect (with-current-buffer buffer - (setq-local flymake-warning-predicate predicate) - (goto-char (point-min)) - (flymake-mode 1) - ;; Weirdness here... https://debbugs.gnu.org/17647#25 - (while (and flymake-is-running (< (setq i (1+ i)) 10)) - (sleep-for (+ 0.5 flymake-no-changes-timeout))) - (flymake-goto-next-error) - (face-at-point)) - (and buffer (let (kill-buffer-query-functions) (kill-buffer buffer)))))) + (save-excursion + (when sev-pred-supplied-p + (setq-local flymake-proc-diagnostic-type-pred severity-predicate)) + (goto-char (point-min)) + (let ((flymake-start-on-flymake-mode nil)) + (unless flymake-mode (flymake-mode 1))) + (flymake-start) + (flymake-tests--wait-for-backends) + (funcall fn))) + (and buffer + (not visiting) + (let (kill-buffer-query-functions) (kill-buffer buffer)))))) + +(cl-defmacro flymake-tests--with-flymake ((file &rest args) + &body body) + (declare (indent 1) + (debug (sexp &rest form))) + `(flymake-tests--call-with-fixture (lambda () ,@body) ,file ,@args)) (ert-deftest warning-predicate-rx-gcc () "Test GCC warning via regexp predicate." (skip-unless (and (executable-find "gcc") (executable-find "make"))) - (should (eq 'flymake-warnline - (flymake-tests--current-face "test.c" "^[Ww]arning")))) + (flymake-tests--with-flymake + ("test.c" :severity-predicate "^[Ww]arning") + (flymake-goto-next-error) + (should (eq 'flymake-warning + (face-at-point))))) (ert-deftest warning-predicate-function-gcc () "Test GCC warning via function predicate." (skip-unless (and (executable-find "gcc") (executable-find "make"))) - (should (eq 'flymake-warnline - (flymake-tests--current-face "test.c" - (lambda (msg) (string-match "^[Ww]arning" msg)))))) + (flymake-tests--with-flymake + ("test.c" :severity-predicate + (lambda (msg) (string-match "^[Ww]arning" msg))) + (flymake-goto-next-error) + (should (eq 'flymake-warning + (face-at-point))))) -(ert-deftest warning-predicate-rx-perl () - "Test perl warning via regular expression predicate." +(ert-deftest perl-backend () + "Test the perl backend." (skip-unless (executable-find "perl")) - (should (eq 'flymake-warnline - (flymake-tests--current-face "test.pl" "^Scalar value")))) + (flymake-tests--with-flymake ("test.pl") + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) + (goto-char (point-max)) + (flymake-goto-prev-error) + (should (eq 'flymake-error (face-at-point))))) + +(defvar ruby-mode-hook) +(ert-deftest ruby-backend () + "Test the ruby backend." + (skip-unless (executable-find "ruby")) + ;; Some versions of ruby fail if HOME doesn't exist (bug#29187). + (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." + (skip-unless (and (executable-find "gcc") + (not (ert-gcc-is-clang-p)) + (version<= + "5" (string-trim + (shell-command-to-string "gcc -dumpversion"))) + (executable-find "make"))) + (let ((flymake-wrap-around nil)) + (flymake-tests--with-flymake + ("errors-and-warnings.c") + (flymake-goto-next-error) + (should (eq 'flymake-error (face-at-point))) + (flymake-goto-next-error) + (should (eq 'flymake-note (face-at-point))) + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) + (flymake-goto-next-error) + (should (eq 'flymake-error (face-at-point))) + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) + (should-error (flymake-goto-next-error nil nil t))))) + +(ert-deftest included-c-header-files () + "Test inclusion of .h header files." + (skip-unless (and (executable-find "gcc") + (not (ert-gcc-is-clang-p)) + (executable-find "make"))) + (let ((flymake-wrap-around nil)) + (flymake-tests--with-flymake + ("some-problems.h") + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) + (flymake-goto-next-error) + (should (eq 'flymake-error (face-at-point))) + (should-error (flymake-goto-next-error nil nil t))) + (flymake-tests--with-flymake + ("no-problems.h") + (should-error (flymake-goto-next-error nil nil t))))) + +(defmacro flymake-tests--assert-set (set + should + should-not) + (declare (indent 1)) + `(progn + ,@(cl-loop + for s in should + collect `(should (memq (quote ,s) ,set))) + ,@(cl-loop + for s in should-not + collect `(should-not (memq (quote ,s) ,set))))) + +(defun flymake-tests--diagnose-words + (report-fn type words) + "Helper. Call REPORT-FN with diagnostics for WORDS in buffer." + (funcall report-fn + (cl-loop + for word in words + append + (save-excursion + (goto-char (point-min)) + (cl-loop while (word-search-forward word nil t) + collect (flymake-make-diagnostic + (current-buffer) + (match-beginning 0) + (match-end 0) + type + (concat word " is wrong"))))))) + +(ert-deftest dummy-backends () + "Test many different kinds of backends." + (with-temp-buffer + (cl-letf + (((symbol-function 'error-backend) + (lambda (report-fn) + (run-with-timer + 0.5 nil + #'flymake-tests--diagnose-words report-fn :error '("manha" "prognata")))) + ((symbol-function 'warning-backend) + (lambda (report-fn) + (run-with-timer + 0.5 nil + #'flymake-tests--diagnose-words report-fn :warning '("ut" "dolor")))) + ((symbol-function 'sync-backend) + (lambda (report-fn) + (flymake-tests--diagnose-words report-fn :note '("quis" "commodo")))) + ((symbol-function 'panicking-backend) + (lambda (report-fn) + (run-with-timer + 0.5 nil + report-fn :panic :explanation "The spanish inquisition!"))) + ((symbol-function 'crashing-backend) + (lambda (_report-fn) + ;; HACK: Shoosh log during tests + (setq-local warning-minimum-log-level :emergency) + (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 + exercitation ullamco laboris nisi ut aliquip ex ea commodo + consequat. Duis aute irure dolor in reprehenderit in + voluptate velit esse cillum dolore eu fugiat nulla + pariatur. Excepteur sint occaecat cupidatat non prognata + sunt in culpa qui officia deserunt mollit anim id est + laborum.") + (let ((flymake-diagnostic-functions + (list 'error-backend 'warning-backend 'sync-backend + 'panicking-backend + 'crashing-backend + )) + (flymake-wrap-around nil)) + (let ((flymake-start-on-flymake-mode nil)) + (flymake-mode)) + (flymake-start) + + (flymake-tests--assert-set (flymake-running-backends) + (error-backend warning-backend panicking-backend) + (crashing-backend)) + + (flymake-tests--assert-set (flymake-disabled-backends) + (crashing-backend) + (error-backend warning-backend sync-backend + panicking-backend)) + + (flymake-tests--wait-for-backends) + + (flymake-tests--assert-set (flymake-disabled-backends) + (crashing-backend panicking-backend) + (error-backend warning-backend sync-backend)) + + (goto-char (point-min)) + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) ; dolor + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) ; ut + (flymake-goto-next-error) + (should (eq 'flymake-error (face-at-point))) ; manha + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) ; Ut + (flymake-goto-next-error) + (should (eq 'flymake-note (face-at-point))) ; quis + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) ; ut + (flymake-goto-next-error) + (should (eq 'flymake-note (face-at-point))) ; commodo + (flymake-goto-next-error) + (should (eq 'flymake-warning (face-at-point))) ; dolor + (flymake-goto-next-error) + (should (eq 'flymake-error (face-at-point))) ; prognata + (should-error (flymake-goto-next-error nil nil t)))))) + +(ert-deftest recurrent-backend () + "Test a backend that calls REPORT-FN multiple times." + (with-temp-buffer + (let (tick) + (cl-letf + (((symbol-function 'eager-backend) + (lambda (report-fn) + (funcall report-fn nil :explanation "very eager but no diagnostics") + (display-buffer (current-buffer)) + (run-with-timer + 0.5 nil + (lambda () + (flymake-tests--diagnose-words report-fn :warning '("consectetur")) + (setq tick t) + (run-with-timer + 0.5 nil + (lambda () + (flymake-tests--diagnose-words report-fn :error '("fugiat")) + (setq tick t)))))))) + (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 + exercitation ullamco laboris nisi ut aliquip ex ea commodo + consequat. Duis aute irure dolor in reprehenderit in + voluptate velit esse cillum dolore eu fugiat nulla + pariatur. Excepteur sint occaecat cupidatat non prognata + sunt in culpa qui officia deserunt mollit anim id est + laborum.") + (let ((flymake-diagnostic-functions + (list 'eager-backend)) + (flymake-wrap-around nil)) + (let ((flymake-start-on-flymake-mode nil)) + (flymake-mode)) + (flymake-start) + (flymake-tests--assert-set (flymake-running-backends) + (eager-backend) ()) + (cl-loop until tick repeat 4 do (sleep-for 0.2)) + (setq tick nil) + (goto-char (point-max)) + (flymake-goto-prev-error) + (should (eq 'flymake-warning (face-at-point))) ; consectetur + (should-error (flymake-goto-prev-error nil nil t)) + (cl-loop until tick repeat 4 do (sleep-for 0.2)) + (flymake-goto-next-error) + (should (eq 'flymake-error (face-at-point))) ; fugiat + (flymake-goto-prev-error) + (should (eq 'flymake-warning (face-at-point))) ; back at consectetur + (should-error (flymake-goto-prev-error nil nil t)) + ))))) + +(ert-deftest eob-region-and-trailing-newline () + "`flymake-diag-region' at eob with varying trailing newlines." + (cl-flet ((diag-region-substring + (line col) + (pcase-let + ((`(,a . ,b) (flymake-diag-region (current-buffer) line col))) + (buffer-substring a b)))) + (with-temp-buffer + (insert "beg\nmmm\nend") + (should (equal + (diag-region-substring 3 3) + "d")) + (should (equal + (diag-region-substring 3 nil) + "end")) + (insert "\n") + (should (equal + (diag-region-substring 4 1) + "end")) + (should (equal + (diag-region-substring 4 nil) + "end")) + (insert "\n") + (should (equal + (diag-region-substring 5 1) + "\n")) + (should (equal + (diag-region-substring 5 nil) + "\n"))))) + -(ert-deftest warning-predicate-function-perl () - "Test perl warning via function predicate." - (skip-unless (executable-find "perl")) - (should (eq 'flymake-warnline - (flymake-tests--current-face - "test.pl" - (lambda (msg) (string-match "^Scalar value" msg)))))) (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 new file mode 100644 index 00000000000..b91eab77057 --- /dev/null +++ b/test/lisp/progmodes/gdb-mi-tests.el @@ -0,0 +1,50 @@ +;;; gdb-mi-tests.el --- tests for gdb-mi.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 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/>. + +;;; Code: + +(require 'ert) +(require 'gdb-mi) + +(ert-deftest gdb-mi-parse-value () + ;; Test the GDB/MI result/value parser. + (should (equal + (gdb-mi--from-string + "alpha=\"ab\\ncd\",beta=[\"x\",{gamma=\"y\",delta=[]}]") + '((alpha . "ab\ncd") + (beta . ("x" ((gamma . "y") (delta . ()))))))) + (should (equal + (gdb-mi--from-string + "alpha=\"ab\\ncd\",beta=[\"x\",{gamma=\"y\",delta=[]}]" + 'gamma) + '((alpha . "ab\ncd") + (beta . ("x" ("y" (delta . ()))))))) + + (let ((gdb-mi-decode-strings nil)) + (let ((ref `((alpha . ,(string-to-multibyte "a\303\245b"))))) + (should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"") + ref)))) + (let ((gdb-mi-decode-strings 'utf-8)) + (should (equal (gdb-mi--from-string "alpha=\"a\\303\\245b\"") + '((alpha . "aåb"))))) + ) + +(provide 'gdb-mi-tests) + +;;; gdb-mi-tests.el ends here diff --git a/test/lisp/progmodes/glasses-tests.el b/test/lisp/progmodes/glasses-tests.el new file mode 100644 index 00000000000..915fb60d3c8 --- /dev/null +++ b/test/lisp/progmodes/glasses-tests.el @@ -0,0 +1,101 @@ +;;; glasses-tests.el --- Tests for glasses.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl <simenheg@gmail.com> +;; Keywords: + +;; 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 'ert) +(require 'glasses) +(require 'seq) + +(ert-deftest glasses-tests-parenthesis-exception-p () + (with-temp-buffer + (insert "public OnClickListener menuListener() {}") + (let ((glasses-separate-parentheses-exceptions '("^Listen"))) + (should-not (glasses-parenthesis-exception-p 1 (point-max))) + (should (glasses-parenthesis-exception-p 15 (point-max))) + (should-not (glasses-parenthesis-exception-p 24 (point-max))) + (should (glasses-parenthesis-exception-p 28 (point-max)))))) + +(ert-deftest glasses-tests-overlay-p () + (should + (glasses-overlay-p (glasses-make-overlay (point-min) (point-max)))) + (should-not + (glasses-overlay-p (make-overlay (point-min) (point-max))))) + +(ert-deftest glasses-tests-make-overlay-p () + (let ((o (glasses-make-overlay (point-min) (point-max)))) + (should (eq (overlay-get o 'category) 'glasses))) + (let ((o (glasses-make-overlay (point-min) (point-max) 'foo))) + (should (eq (overlay-get o 'category) 'foo)))) + +(ert-deftest glasses-tests-make-readable () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (glasses-make-readable (point-min) (point-max)) + (pcase-let ((`(,o1 ,o2 ,o3) + (sort (overlays-in (point-min) (point-max)) + (lambda (o1 o2) + (< (overlay-start o1) (overlay-start o2)))))) + (should (= (overlay-start o1) 7)) + (should (equal (overlay-get o1 'before-string) + glasses-separator)) + (should (= (overlay-start o2) 17)) + (should (equal (overlay-get o2 'before-string) + glasses-separator)) + (should (= (overlay-start o3) 25)) + (should (equal (overlay-get o3 'before-string) " "))))) + +(ert-deftest glasses-tests-make-readable-dont-separate-parentheses () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (let ((glasses-separate-parentheses-p nil)) + (glasses-make-readable (point-min) (point-max)) + (should-not (overlays-at 25))))) + +(ert-deftest glasses-tests-make-unreadable () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (glasses-make-readable (point-min) (point-max)) + (should (seq-some #'glasses-overlay-p + (overlays-in (point-min) (point-max)))) + (glasses-make-unreadable (point-min) (point-max)) + (should-not (seq-some #'glasses-overlay-p + (overlays-in (point-min) (point-max)))))) + +(ert-deftest glasses-tests-convert-to-unreadable () + (with-temp-buffer + (insert "set_Background_Resource(R.button_right);") + (let ((glasses-convert-on-write-p nil)) + (should-not (glasses-convert-to-unreadable)) + (should (equal (buffer-string) + "set_Background_Resource(R.button_right);"))) + (let ((glasses-convert-on-write-p t)) + (should-not (glasses-convert-to-unreadable)) + (should (equal (buffer-string) + "setBackgroundResource(R.button_right);"))))) + +(provide 'glasses-tests) +;;; glasses-tests.el ends here diff --git a/test/lisp/progmodes/grep-tests.el b/test/lisp/progmodes/grep-tests.el new file mode 100644 index 00000000000..101052c5adc --- /dev/null +++ b/test/lisp/progmodes/grep-tests.el @@ -0,0 +1,69 @@ +;;; grep-tests.el --- Test suite for grep.el -*- lexical-binding:t -*- + +;; Copyright (C) 2021-2022 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 'ert) +(require 'grep) + +(defconst grep-tests--ellipsis (if (char-displayable-p ?…) "[…]" "[...]") + "The form that the ellipsis takes in `grep-find-abbreviate-properties'.") + +(defun grep-tests--get-rgrep-abbreviation () + "Get the `display' property of the excessive part of the rgrep command." + (with-temp-buffer + (grep-compute-defaults) + (insert (rgrep-default-command "search" "*" nil)) + (grep-mode) + (font-lock-mode) + (font-lock-ensure) + (goto-char (point-min)) + (re-search-forward "find ") + (get-text-property (point) 'display))) + +(defun grep-tests--check-rgrep-abbreviation () + "Check that the excessive part of the rgrep command is abbreviated iff +`grep-find-abbreviate' is non-nil." + (let ((grep-find-abbreviate t)) + (should (equal (grep-tests--get-rgrep-abbreviation) + grep-tests--ellipsis))) + (let ((grep-find-abbreviate nil)) + (should-not (grep-tests--get-rgrep-abbreviation)))) + +(ert-deftest grep-tests--rgrep-abbreviate-properties-gnu-linux () + (let ((system-type 'gnu/linux)) + (grep-tests--check-rgrep-abbreviation))) + +(ert-deftest grep-tests--rgrep-abbreviate-properties-darwin () + (let ((system-type 'darwin)) + (grep-tests--check-rgrep-abbreviation))) + +(ert-deftest grep-tests--rgrep-abbreviate-properties-windows-nt-dos-semantics () + (let ((system-type 'windows-nt)) + (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'always)) + (grep-tests--check-rgrep-abbreviation)))) + +(ert-deftest grep-tests--rgrep-abbreviate-properties-windows-nt-sh-semantics () + (let ((system-type 'windows-nt)) + (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'ignore)) + (grep-tests--check-rgrep-abbreviation)))) + +;;; grep-tests.el ends here diff --git a/test/lisp/progmodes/hideshow-tests.el b/test/lisp/progmodes/hideshow-tests.el new file mode 100644 index 00000000000..22d73fb3c46 --- /dev/null +++ b/test/lisp/progmodes/hideshow-tests.el @@ -0,0 +1,374 @@ +;;; hideshow-tests.el --- Test suite for hideshow.el -*- lexical-binding:t -*- + +;; Copyright (C) 2022 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 'ert) +(require 'ert-x) +(require 'hideshow) + +;; Dependencies for testing: +(require 'cc-mode) + + +(defmacro hideshow-tests-with-temp-buffer (mode contents &rest body) + "Create a `hs-minor-mode' enabled MODE temp buffer with CONTENTS. +BODY is code to be executed within the temp buffer. Point is +always located at the beginning of buffer." + (declare (indent 1) (debug t)) + `(with-temp-buffer + (,mode) + (hs-minor-mode 1) + (insert ,contents) + (goto-char (point-min)) + ,@body)) + +(defmacro hideshow-tests-with-temp-buffer-selected (mode contents &rest body) + "Create and switch to a `hs-minor-mode' enabled MODE temp buffer with CONTENTS. +BODY is code to be executed within the temp buffer. Point is +always located at the beginning of buffer." + (declare (indent 1) (debug t)) + `(ert-with-test-buffer-selected () + (,mode) + (hs-minor-mode 1) + (insert ,contents) + (goto-char (point-min)) + ,@body)) + +(defun hideshow-tests-look-at (string &optional num restore-point) + "Move point at beginning of STRING in the current buffer. +Optional argument NUM defaults to 1 and is an integer indicating +how many occurrences must be found, when positive the search is +done forwards, otherwise backwards. When RESTORE-POINT is +non-nil the point is not moved but the position found is still +returned. When searching forward and point is already looking at +STRING, it is skipped so the next STRING occurrence is selected." + (let* ((num (or num 1)) + (starting-point (point)) + (string (regexp-quote string)) + (search-fn (if (> num 0) #'re-search-forward #'re-search-backward)) + (deinc-fn (if (> num 0) #'1- #'1+)) + (found-point)) + (prog2 + (catch 'exit + (while (not (= num 0)) + (when (and (> num 0) + (looking-at string)) + ;; Moving forward and already looking at STRING, skip it. + (forward-char (length (match-string-no-properties 0)))) + (and (not (funcall search-fn string nil t)) + (throw 'exit t)) + (when (> num 0) + ;; `re-search-forward' leaves point at the end of the + ;; occurrence, move back so point is at the beginning + ;; instead. + (forward-char (- (length (match-string-no-properties 0))))) + (setq + num (funcall deinc-fn num) + found-point (point)))) + found-point + (and restore-point (goto-char starting-point))))) + +(defun hideshow-tests-visible-string (&optional min max) + "Return the buffer string excluding invisible overlays. +Argument MIN and MAX delimit the region to be returned and +default to `point-min' and `point-max' respectively." + (let* ((min (or min (point-min))) + (max (or max (point-max))) + (buffer-contents (buffer-substring-no-properties min max)) + (overlays + (sort (overlays-in min max) + (lambda (a b) + (let ((overlay-end-a (overlay-end a)) + (overlay-end-b (overlay-end b))) + (> overlay-end-a overlay-end-b)))))) + (with-temp-buffer + (insert buffer-contents) + (dolist (overlay overlays) + (if (overlay-get overlay 'invisible) + (delete-region (overlay-start overlay) + (overlay-end overlay)))) + (buffer-substring-no-properties (point-min) (point-max))))) + +(defun hideshow-tests-make-event-at (string) + "Make dummy mouse event at beginning of STRING." + (save-excursion + (let ((pos (hideshow-tests-look-at string))) + (vector + `(S-mouse-2 + (,(get-buffer-window) ,pos (1 . 1) 0 nil ,pos (1 . 1) + nil (1 . 1) (1 . 1))))))) + +(ert-deftest hideshow-already-hidden-p-1 () + (let ((contents " +int +main() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (hideshow-tests-look-at "printf") + (should (not (hs-already-hidden-p))) + (hs-hide-block) + (goto-char (point-min)) + (hideshow-tests-look-at "{") + (should (hs-already-hidden-p)) + (forward-line -1) + (should (not (hs-already-hidden-p))) + (hideshow-tests-look-at "}") + (should (hs-already-hidden-p)) + (forward-line) + (should (not (hs-already-hidden-p)))))) + +(ert-deftest hideshow-hide-block-1 () + "Should hide current block." + (let ((contents " +int +main() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (hideshow-tests-look-at "printf") + (hs-hide-block) + (should (string= + (hideshow-tests-visible-string) + " +int +main() +{} +")) + (hs-show-block) + (should (string= (hideshow-tests-visible-string) contents))))) + +(ert-deftest hideshow-hide-all-1 () + "Should hide all blocks and comments." + (let ((contents " +/* + Comments +*/ + +int +main() +{ + sub(); +} + +void +sub() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (hs-hide-all) + (should (string= + (hideshow-tests-visible-string) + " +/* + +int +main() +{} + +void +sub() +{} +")) + (hs-show-all) + (should (string= (hideshow-tests-visible-string) contents))))) + +(ert-deftest hideshow-hide-all-2 () + "Should not hide comments when `hs-hide-comments-when-hiding-all' is nil." + (let ((contents " +/* + Comments +*/ + +int +main() +{ + sub(); +} + +void +sub() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (let ((hs-hide-comments-when-hiding-all nil)) + (hs-hide-all)) + (should (string= + (hideshow-tests-visible-string) + " +/* + Comments +*/ + +int +main() +{} + +void +sub() +{} +")) + (hs-show-all) + (should (string= (hideshow-tests-visible-string) contents))))) + +(ert-deftest hideshow-hide-level-1 () + "Should hide 1st level blocks." + (hideshow-tests-with-temp-buffer + c-mode + " +/* + Comments +*/ + +int +main(int argc, char **argv) +{ + if (argc > 1) { + printf(\"Hello\\n\"); + } +} +" + (hs-hide-level 1) + (should (string= + (hideshow-tests-visible-string) + " +/* + Comments +*/ + +int +main(int argc, char **argv) +{} +")))) + +(ert-deftest hideshow-hide-level-2 () + "Should hide 2nd level blocks." + (hideshow-tests-with-temp-buffer + c-mode + " +/* + Comments +*/ + +int +main(int argc, char **argv) +{ + if (argc > 1) { + printf(\"Hello\\n\"); + } +} +" + (hs-hide-level 2) + (should (string= + (hideshow-tests-visible-string) + " +/* + Comments +*/ + +int +main(int argc, char **argv) +{ + if (argc > 1) {} +} +")))) + +(ert-deftest hideshow-toggle-hiding-1 () + "Should toggle hiding/showing of a block." + (let ((contents " +int +main() +{ + printf(\"Hello\\n\"); +} +")) + (hideshow-tests-with-temp-buffer + c-mode + contents + (hideshow-tests-look-at "printf") + (hs-toggle-hiding) + (should (string= + (hideshow-tests-visible-string) + " +int +main() +{} +")) + (hs-toggle-hiding) + (should (string= (hideshow-tests-visible-string) contents))))) + +(ert-deftest hideshow-mouse-toggle-hiding-1 () + "Should toggle hiding/showing of a block by mouse events." + (let ((contents " +int +main() +{ + printf(\"Hello\\n\"); +} +") + (hidden " +int +main() +{} +") + (call-at (lambda (str) + (let* ((events (hideshow-tests-make-event-at str)) + (last-nonmenu-event (aref events 0))) + (call-interactively #'hs-toggle-hiding nil events))))) + (hideshow-tests-with-temp-buffer-selected + c-mode + contents + ;; Should not hide the block when clicked outside of the block. + (funcall call-at "int") + (should (string= (hideshow-tests-visible-string) contents)) + ;; Should hide the block when clicked inside of the block. + (goto-char (point-min)) + (funcall call-at "printf") + (should (string= (hideshow-tests-visible-string) hidden)) + ;; Should not show the block when clicked outside of the block. + (goto-char (point-min)) + (funcall call-at "int") + (should (string= (hideshow-tests-visible-string) hidden)) + ;; Should show the block when clicked inside of the block. + (goto-char (point-min)) + (funcall call-at "}") + (should (string= (hideshow-tests-visible-string) contents))))) + +(provide 'hideshow-tests) + +;;; hideshow-tests.el ends here diff --git a/test/lisp/progmodes/js-resources/js-chain.js b/test/lisp/progmodes/js-resources/js-chain.js new file mode 100644 index 00000000000..2a290294026 --- /dev/null +++ b/test/lisp/progmodes/js-resources/js-chain.js @@ -0,0 +1,29 @@ +// Normal chaining. +let x = svg.mumble() + .zzz; + +// Chaining with an intervening line comment. +let x = svg.mumble() // line comment + .zzz; + +// Chaining with multiple dots. +let x = svg.selectAll().something() + .zzz; + +// Nested chaining. +let x = svg.selectAll(d3.svg.something() + .zzz); + +// Nothing to chain to. +let x = svg() + .zzz; + +// Nothing to chain to. +let x = svg().mumble.x() + 73 + .zzz; + +// Local Variables: +// indent-tabs-mode: nil +// js-chain-indent: t +// js-indent-level: 2 +// End: diff --git a/test/lisp/progmodes/js-resources/js-indent-align-list-continuation-nil.js b/test/lisp/progmodes/js-resources/js-indent-align-list-continuation-nil.js new file mode 100644 index 00000000000..383b2539a26 --- /dev/null +++ b/test/lisp/progmodes/js-resources/js-indent-align-list-continuation-nil.js @@ -0,0 +1,20 @@ +const funcAssignment = function (arg1, + arg2, + arg3) { + return { test: this, + which: "would", + align: "as well with the default setting" + }; +} + +function funcDeclaration(arg1, + arg2 +) { + return [arg1, + arg2]; +} + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-align-list-continuation: nil +// End: diff --git a/test/lisp/progmodes/js-resources/js-indent-init-dynamic.js b/test/lisp/progmodes/js-resources/js-indent-init-dynamic.js new file mode 100644 index 00000000000..536a976e86e --- /dev/null +++ b/test/lisp/progmodes/js-resources/js-indent-init-dynamic.js @@ -0,0 +1,30 @@ +var foo = function() { + return 7; +}; + +var foo = function() { + return 7; + }, + bar = 8; + +var foo = function() { + return 7; + }, + bar = function() { + return 8; + }; + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// js-indent-first-init: dynamic +// End: + +// The following test intentionally produces a scan error and should +// be placed below all other tests to prevent awkward indentation. +// (It still thinks it's within the body of a function.) + +var foo = function() { + return 7; + , + bar = 8; diff --git a/test/lisp/progmodes/js-resources/js-indent-init-t.js b/test/lisp/progmodes/js-resources/js-indent-init-t.js new file mode 100644 index 00000000000..bb755420ba7 --- /dev/null +++ b/test/lisp/progmodes/js-resources/js-indent-init-t.js @@ -0,0 +1,21 @@ +var foo = function() { + return 7; + }; + +var foo = function() { + return 7; + }, + bar = 8; + +var foo = function() { + return 7; + }, + bar = function() { + return 8; + }; + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// js-indent-first-init: t +// End: diff --git a/test/lisp/progmodes/js-resources/js.js b/test/lisp/progmodes/js-resources/js.js new file mode 100644 index 00000000000..9658c95701c --- /dev/null +++ b/test/lisp/progmodes/js-resources/js.js @@ -0,0 +1,171 @@ +var a = 1; +b = 2; + +let c = 1, + d = 2; + +var e = 100500, + + 1; + +// Don't misinterpret "const" +/const/ + +function test () +{ + return /[/]/.test ('/') // (bug#19397) +} + +var f = bar('/protocols/') +baz(); + +var h = 100500 +1; + +const i = 1, + j = 2; + +var k = 1, + l = [ + 1, 2, + 3, 4 + ], + m = 5; + +var n = function() { + return 7; +}, + o = 8; + +foo(bar, function() { + return 2; +}); + +switch (b) { +case "a": + 2; +default: + 3; +} + +var p = { + case: 'zzzz', + default: 'donkey', + tee: 'ornery' +}; + +var evens = [e for each (e in range(0, 21)) + if (ed % 2 == 0)]; + +var funs = [ + function() { + for (;;) { + } + }, + function(){}, +]; + +!b + !=b + !==b + +a++ +b += + c + +var re = /some value/ +str.match(re) + +baz(`http://foo.bar/${tee}`) + .qux(); + +`multiline string + contents + are kept + unchanged!` + +class A { + * x() { + return 1 + * a(2); + } + + *[Symbol.iterator]() { + yield "Foo"; + yield "Bar"; + } +} + +if (true) + 1 +else + 2 + +Foobar + .find() + .catch((err) => { + return 2; + }) + .then((num) => { + console.log(num); + }); + +var z = [ + ...iterableObj, + 4, + 5 +] + +var arr = [ + -1, 2, + -3, 4 + + -5 +]; + +// Regression test for bug#15582. +if (x > 72 && + y < 85) { // found + do_something(); +} + +// Test that chaining doesn't happen when js-chain-indent is nil. +let x = svg.mumble() + .zzz; + +// https://github.com/mooz/js2-mode/issues/405 +if (1) { + isSet + ? (isEmpty ? 2 : 3) + : 4 +} + +// Regexp is not a continuation +bar( + "string arg1", + /abc/ +) + +// No infloop inside js--re-search-backward-inner +let b = { + a : ` + //1 + ` +} + +// bug#25904 +foo.bar.baz(very => // A comment + very +).biz(([baz={a: [123]}, boz]) => + baz +).snarf((snorf) => /* Another comment */ + snorf +); + +// Continuation of bug#25904; support broken arrow as N+1th arg +map(arr, (val) => + val +) + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: diff --git a/test/lisp/progmodes/js-resources/jsx-align-gt-with-lt.jsx b/test/lisp/progmodes/js-resources/jsx-align-gt-with-lt.jsx new file mode 100644 index 00000000000..8eb1d6d718c --- /dev/null +++ b/test/lisp/progmodes/js-resources/jsx-align-gt-with-lt.jsx @@ -0,0 +1,12 @@ +<element + attr="" + > +</element> +<input + /> + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// js-jsx-align->-with-<: nil +// End: diff --git a/test/lisp/progmodes/js-resources/jsx-comment-string.jsx b/test/lisp/progmodes/js-resources/jsx-comment-string.jsx new file mode 100644 index 00000000000..cae023e7288 --- /dev/null +++ b/test/lisp/progmodes/js-resources/jsx-comment-string.jsx @@ -0,0 +1,23 @@ +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following tests go below any comments to avoid including +// misindented comments among the erroring lines. + +// The JSX-like text in comments/strings should be treated like the enclosing +// syntax, not like JSX. + +// <Foo> +void 0 + +"<Bar>" +void 0 + +<Chicken> + {/* <Pork> */} + <Beef attr="<Turkey>"> + Yum! + </Beef> +</Chicken> diff --git a/test/lisp/progmodes/js-resources/jsx-indent-level.jsx b/test/lisp/progmodes/js-resources/jsx-indent-level.jsx new file mode 100644 index 00000000000..0a84b9eb77a --- /dev/null +++ b/test/lisp/progmodes/js-resources/jsx-indent-level.jsx @@ -0,0 +1,13 @@ +return ( + <element> + <element> + Hello World! + </element> + </element> +) + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 4 +// js-jsx-indent-level: 2 +// End: diff --git a/test/lisp/progmodes/js-resources/jsx-quote.jsx b/test/lisp/progmodes/js-resources/jsx-quote.jsx new file mode 100644 index 00000000000..1b2c6528734 --- /dev/null +++ b/test/lisp/progmodes/js-resources/jsx-quote.jsx @@ -0,0 +1,16 @@ +// JSX text node values should be strings, but only JS string syntax +// is considered, so quote marks delimit strings like normal, with +// disastrous results (https://github.com/mooz/js2-mode/issues/409). +function Bug() { + return <div>C'est Montréal</div>; +} +function Test(foo = /'/, + bar = 123) {} + +// This test is in a separate file because it can break other tests +// when indenting the whole buffer (not sure why). + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: diff --git a/test/lisp/progmodes/js-resources/jsx-self-closing.jsx b/test/lisp/progmodes/js-resources/jsx-self-closing.jsx new file mode 100644 index 00000000000..f8ea7a138ad --- /dev/null +++ b/test/lisp/progmodes/js-resources/jsx-self-closing.jsx @@ -0,0 +1,13 @@ +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following test goes below any comments to avoid including +// misindented comments among the erroring lines. + +// Properly parse/indent code with a self-closing tag inside the +// attribute of another self-closing tag. +<div> + <div attr={() => <div attr="" />} /> +</div> diff --git a/test/lisp/progmodes/js-resources/jsx-unclosed-1.jsx b/test/lisp/progmodes/js-resources/jsx-unclosed-1.jsx new file mode 100644 index 00000000000..1f5c3fba8da --- /dev/null +++ b/test/lisp/progmodes/js-resources/jsx-unclosed-1.jsx @@ -0,0 +1,13 @@ +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following test goes below any comments to avoid including +// misindented comments among the erroring lines. + +return ( + <div> + {array.map(function () { + return { + a: 1 diff --git a/test/lisp/progmodes/js-resources/jsx-unclosed-2.jsx b/test/lisp/progmodes/js-resources/jsx-unclosed-2.jsx new file mode 100644 index 00000000000..fb665b96a43 --- /dev/null +++ b/test/lisp/progmodes/js-resources/jsx-unclosed-2.jsx @@ -0,0 +1,65 @@ +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following tests go below any comments to avoid including +// misindented comments among the erroring lines. + +// Don’t misinterpret inequality operators as JSX. +for (; i < length;) void 0 +if (foo > bar) void 0 + +// Don’t misintrepet inequalities within JSX, either. +<div> + {foo < bar} +</div> + +// Don’t even misinterpret unary operators as JSX. +if (foo < await bar) void 0 +while (await foo > bar) void 0 + +<div> + {foo < await bar} +</div> + +// Allow unary keyword names as null-valued JSX attributes. +// (As if this will EVER happen…) +<Foo yield> + <Bar void> + <Baz + zorp + typeof> + <Please do_n0t delete this_stupidTest > + How would we ever live without unary support + </Please> + </Baz> + </Bar> +</Foo> + +// “-” is not allowed in a JSXBoundaryElement’s name. +<ABC /> + <A-B-C /> // Weirdly-indented “continued expression.” + +// “-” may be used in a JSXAttribute’s name. +<Foo a-b-c="" + x-y-z="" /> + +// Weird spaces should be tolerated. +< div > + < div > + < div + attr="" + / > + < div + attr="" + / > + < / div> +< / div > + +// Non-ASCII identifiers are acceptable. +<Über> + <Québec διακριτικός sueño=""> + Guten Tag! + </Québec> +</Über> diff --git a/test/lisp/progmodes/js-resources/jsx.jsx b/test/lisp/progmodes/js-resources/jsx.jsx new file mode 100644 index 00000000000..c200979df8c --- /dev/null +++ b/test/lisp/progmodes/js-resources/jsx.jsx @@ -0,0 +1,314 @@ +var foo = <div></div>; + +return ( + <div> + </div> + <div> + <div></div> + <div> + <div></div> + </div> + </div> +); + +React.render( + <div> + <div></div> + </div>, + { + a: 1 + }, + <div> + <div></div> + </div> +); + +return ( + // Sneaky! + <div></div> +); + +return ( + <div></div> + // Sneaky! +); + +React.render( + <input + />, + { + a: 1 + } +); + +return ( + <div> + {array.map(function () { + return { + a: 1 + }; + })} + </div> +); + +return ( + <div attribute={array.map(function () { + return { + a: 1 + }; + + return { + a: 1 + }; + + return { + a: 1 + }; + })}> + </div> +); + +return ( + <div attribute={{ + a: 1, // Indent relative to “attribute” column. + b: 2 + } && { // Dedent to “attribute” column. + a: 1, + b: 2 + }} /> // Also dedent. +); + +return ( + <div attribute= + { // Indent properly on another line, too. + { + a: 1, + b: 2, + } && ( + // Indent other forms, too. + a ? b : + c ? d : + e + ) + } /> +) + +// JSXMemberExpression names are parsed/indented: +<Foo.Bar> + <div> + <Foo.Bar> + Hello World! + </Foo.Bar> + <Foo.Bar> + <div> + </div> + </Foo.Bar> + </div> +</Foo.Bar> + +// JSXOpeningFragment and JSXClosingFragment are parsed/indented: +<> + <div> + <> + Hello World! + </> + <> + <div> + </div> + </> + </div> +</> + +// Indent void expressions (no need for contextual parens / commas) +// (https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016). +<div className="class-name"> + <h2>Title</h2> + {array.map(() => { + return <Element />; + })} + {message} +</div> +// Another example of above issue +// (https://github.com/mooz/js2-mode/issues/490). +<App> + <div> + {variable1} + <Component/> + </div> +</App> + +// Comments and arrows can break indentation (Bug#24896 / +// https://github.com/mooz/js2-mode/issues/389). +const Component = props => ( + <FatArrow a={e => c} + b={123}> + </FatArrow> +); +const Component = props => ( + <NoFatArrow a={123} + b={123}> + </NoFatArrow> +); +const Component = props => ( // Parse this comment, please. + <FatArrow a={e => c} + b={123}> + </FatArrow> +); +const Component = props => ( // Parse this comment, please. + <NoFatArrow a={123} + b={123}> + </NoFatArrow> +); +// Another example of above issue (Bug#30225). +class { + render() { + return ( + <select style={{paddingRight: "10px"}} + onChange={e => this.setState({value: e.target.value})} + value={this.state.value}> + <option>Hi</option> + </select> + ); + } +} + +// JSX attributes of an arrow function’s expression body’s JSX +// expression should be indented with respect to the JSX opening +// element (Bug#26001 / +// https://github.com/mooz/js2-mode/issues/389#issuecomment-271869380). +class { + render() { + const messages = this.state.messages.map( + message => <Message key={message.id} + text={message.text} + mine={message.mine} /> + ); return messages; + } + render() { + const messages = this.state.messages.map(message => + <Message key={message.timestamp} + text={message.text} + mine={message.mine} /> + ); return messages; + } +} + +// Users expect tag closers to align with the tag’s start; this is the +// style used in the React docs, so it should be the default. +// - https://github.com/mooz/js2-mode/issues/389#issuecomment-390766873 +// - https://github.com/mooz/js2-mode/issues/482 +// - Bug#32158 +const foo = (props) => ( + <div> + <input + cat={i => i} + /> + <button + className="square" + > + {this.state.value} + </button> + </div> +); + +// Embedded JSX in parens breaks indentation +// (https://github.com/mooz/js2-mode/issues/411). +let a = ( + <div> + {condition && <Component/>} + {condition && <Component/>} + <div/> + </div> +) +let b = ( + <div> + {condition && (<Component/>)} + <div/> + </div> +) +let c = ( + <div> + {condition && (<Component/>)} + {condition && "something"} + </div> +) +let d = ( + <div> + {(<Component/>)} + {condition && "something"} + </div> +) +// Another example of the above issue (Bug#27000). +function testA() { + return ( + <div> + <div> { ( <div/> ) } </div> + </div> + ); +} +function testB() { + return ( + <div> + <div> { <div/> } </div> + </div> + ); +} +// Another example of the above issue +// (https://github.com/mooz/js2-mode/issues/451). +class Classy extends React.Component { + render () { + return ( + <div> + <ul className="tocListRoot"> + { this.state.list.map((item) => { + return (<div />) + })} + </ul> + </div> + ) + } +} + +// Self-closing tags should be indented properly +// (https://github.com/mooz/js2-mode/issues/459). +export default ({ stars }) => ( + <div className='overlay__container'> + <div className='overlay__header overlay--text'> + Congratulations! + </div> + <div className='overlay__reward'> + <Icon {...createIconProps(stars > 0)} size='large' /> + <div className='overlay__reward__bottom'> + <Icon {...createIconProps(stars > 1)} size='small' /> + <Icon {...createIconProps(stars > 2)} size='small' /> + </div> + </div> + <div className='overlay__description overlay--text'> + You have created <large>1</large> reminder + </div> + </div> +) + +// JS expressions should not break indentation +// (https://github.com/mooz/js2-mode/issues/462). +// +// In the referenced issue, the user actually wanted indentation which +// was simply different than Emacs’ SGML attribute indentation. +// Nevertheless, his issue highlighted our inability to properly +// indent code with JSX inside JSXExpressionContainers inside JSX. +return ( + <Router> + <Bar> + <Route exact path="/foo" + render={() => ( + <div>nothing</div> + )} /> + <Route exact path="/bar" /> + </Bar> + </Router> +) + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el index 35143b1ec79..2ce9db65d47 100644 --- a/test/lisp/progmodes/js-tests.el +++ b/test/lisp/progmodes/js-tests.el @@ -1,6 +1,6 @@ -;;; js-tests.el --- Test suite for js-mode +;;; js-tests.el --- Test suite for js-mode -*- lexical-binding:t -*- -;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Copyright (C) 2017-2022 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'js) (require 'syntax) @@ -196,6 +197,46 @@ if (!/[ (:,='\"]/.test(value)) { ;; The bug was a hang. (should t))) +;;;; Indentation tests. + +(defun js-tests--remove-indentation () + "Remove all indentation in the current buffer." + (goto-char (point-min)) + (while (re-search-forward (rx bol (+ (in " \t"))) nil t) + (let ((syntax (save-match-data (syntax-ppss)))) + (unless (nth 3 syntax) ; Avoid multiline string literals. + (replace-match ""))))) + +(defmacro js-deftest-indent (file) + `(ert-deftest ,(intern (format "js-indent-test/%s" file)) () + :tags '(:expensive-test) + (let ((buf (find-file-noselect (ert-resource-file ,file)))) + (unwind-protect + (with-current-buffer buf + (let ((orig (buffer-string))) + (js-tests--remove-indentation) + ;; Indent and check that we get the original text. + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig)) + ;; Verify idempotency. + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig)))) + (kill-buffer buf))))) + +(js-deftest-indent "js-chain.js") +(js-deftest-indent "js-indent-align-list-continuation-nil.js") +(js-deftest-indent "js-indent-init-dynamic.js") +(js-deftest-indent "js-indent-init-t.js") +(js-deftest-indent "js.js") +(js-deftest-indent "jsx-align-gt-with-lt.jsx") +(js-deftest-indent "jsx-comment-string.jsx") +(js-deftest-indent "jsx-indent-level.jsx") +(js-deftest-indent "jsx-quote.jsx") +(js-deftest-indent "jsx-self-closing.jsx") +(js-deftest-indent "jsx-unclosed-1.jsx") +(js-deftest-indent "jsx-unclosed-2.jsx") +(js-deftest-indent "jsx.jsx") + (provide 'js-tests) ;;; js-tests.el ends here diff --git a/test/lisp/progmodes/octave-tests.el b/test/lisp/progmodes/octave-tests.el new file mode 100644 index 00000000000..76dd5c9e5f7 --- /dev/null +++ b/test/lisp/progmodes/octave-tests.el @@ -0,0 +1,49 @@ +;;; octave-tests.el --- Test suite for octave.el -*- lexical-binding:t -*- + +;; Copyright (C) 2021-2022 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 'ert) +(require 'octave) + +(defun octave-test--indent (string) + (with-temp-buffer + (octave-mode) + (insert string) + (indent-region (point-min) (point-max)) + (buffer-string))) + +(ert-deftest octave-tests--continuation-indentation () + (should + (equal (octave-test--indent "a = b + a * \\ +c; +") + "a = b + a * \\ + c; +")) + (should (equal (octave-test--indent "a = \\ +b; +") + "a = \\ + b; +"))) + +;;; octave-tests.el ends here diff --git a/test/lisp/progmodes/opascal-tests.el b/test/lisp/progmodes/opascal-tests.el new file mode 100644 index 00000000000..cf6bd376142 --- /dev/null +++ b/test/lisp/progmodes/opascal-tests.el @@ -0,0 +1,47 @@ +;;; opascal-tests.el --- tests for opascal.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 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/>. + +;;; Code: + +(require 'ert) +(require 'opascal) + +(ert-deftest opascal-indent-bug-36348 () + (with-temp-buffer + (opascal-mode) + (let ((orig "{ -*- opascal -*- } + +procedure Toto (); +begin + for i := 0 to 1 do + Write (str.Chars[i]); + + // bug#36348 + for var i := 0 to 1 do + Write (str.Chars[i]); + +end; +")) + (insert orig) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + +(provide 'opascal-tests) + +;;; opascal-tests.el ends here diff --git a/test/lisp/progmodes/pascal-tests.el b/test/lisp/progmodes/pascal-tests.el new file mode 100644 index 00000000000..fb9b52fb864 --- /dev/null +++ b/test/lisp/progmodes/pascal-tests.el @@ -0,0 +1,67 @@ +;;; pascal-tests.el --- tests for pascal.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 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/>. + +;;; Code: + +(require 'ert) +(require 'pascal) + +(ert-deftest pascal-completion () + ;; Bug#41740: completion functions must preserve point. + (let ((pascal-completion-cache nil)) + (with-temp-buffer + (pascal-mode) + (insert "program test; var") + (let* ((point-before (point)) + (completions (pascal-completion "var" nil 'metadata)) + (point-after (point))) + (should (equal completions nil)) + (should (equal point-before point-after))))) + + (let ((pascal-completion-cache nil)) + (with-temp-buffer + (pascal-mode) + (insert "program test; function f(x : i") + (let* ((point-before (point)) + (completions (pascal-completion "i" nil 'metadata)) + (point-after (point))) + (should (equal completions nil)) + (should (equal point-before point-after))))) + + (let ((pascal-completion-cache nil)) + (with-temp-buffer + (pascal-mode) + (insert "program test; function f(x : integer) : real") + (let* ((point-before (point)) + (completions (pascal-completion "real" nil 'metadata)) + (point-after (point))) + (should (equal completions nil)) + (should (equal point-before point-after)))))) + +(ert-deftest pascal-beg-of-defun () + (with-temp-buffer + (pascal-mode) + (insert "program test; procedure p(") + (forward-char -1) + (pascal-beg-of-defun) + (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 new file mode 100644 index 00000000000..91f1db23d62 --- /dev/null +++ b/test/lisp/progmodes/perl-mode-tests.el @@ -0,0 +1,42 @@ +;;; perl-mode-tests.el --- Test for perl-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 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/>. + +;;; Code: + +(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) +(setq cperl-test-mode #'perl-mode) +(load-file (expand-file-name "cperl-mode-tests.el" + (file-truename + (file-name-directory (or load-file-name + buffer-file-name))))) + +(setq ert-load-file-name load-file-name) + +;;; perl-mode-tests.el ends here diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el new file mode 100644 index 00000000000..d4b6bca7e8f --- /dev/null +++ b/test/lisp/progmodes/project-tests.el @@ -0,0 +1,113 @@ +;;; project-tests.el --- tests for project.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2022 Free Software Foundation, Inc. + +;; Keywords: + +;; 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: + +;; Unit tests for progmodes/project.el. + +;;; Code: + +(require 'project) + +(require 'cl-lib) +(require 'ert) +(require 'ert-x) ; ert-with-temp-directory +(require 'grep) +(require 'xref) + +(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")) + (ert-with-temp-directory directory + (let ((default-directory directory) + (project-current-inhibit-prompt t) + (project-find-functions nil) + (project-list-file + (expand-file-name "projects" directory)) + (project (cons 'transient (file-name-quote directory))) + (file (expand-file-name "file" directory))) + (add-hook 'project-find-functions (lambda (_dir) project)) + (should (eq (project-current) project)) + (write-region "contents" nil file nil nil nil 'excl) + (should (equal (project-files project) + (list (file-name-quote file)))) + (let* ((references nil) + (xref-search-program 'grep) + (xref-show-xrefs-function + (lambda (fetcher _display) + (push (funcall fetcher) references)))) + (project-find-regexp "tent") + (pcase references + (`((,item)) + ;; FIXME: Shouldn't `xref-match-item' be a subclass of + ;; `xref-item'? + (should (cl-typep item '(or xref-item xref-match-item))) + (should (file-equal-p + (xref-location-group (xref-item-location item)) + file))) + (otherwise + (ert-fail (format-message "Unexpected references: %S" + otherwise)))))))) + +(cl-defstruct project-tests--trivial root ignores) + +(cl-defmethod project-root ((project project-tests--trivial)) + (project-tests--trivial-root project)) + +(cl-defmethod project-ignores ((project project-tests--trivial) _dir) + (project-tests--trivial-ignores project)) + +(ert-deftest project-ignores () + "Check that `project-files' correctly ignores the files +returned by `project-ignores' if the root directory is a +directory name (Bug#48471)." + (skip-unless (executable-find find-program)) + (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 + :root (file-name-as-directory dir) + :ignores '("./ignored-file"))) + (files (project-files project)) + (relative-files + (cl-loop for file in files + 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/ps-mode-tests.el b/test/lisp/progmodes/ps-mode-tests.el new file mode 100644 index 00000000000..7fa40eb0cb4 --- /dev/null +++ b/test/lisp/progmodes/ps-mode-tests.el @@ -0,0 +1,72 @@ +;;; ps-mode-tests.el --- Test suite for ps-mode -*- lexical-binding:t -*- + +;; Copyright (C) 2019-2022 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 'ert) +(require 'ps-mode) + +(ert-deftest ps-mode-test-octal-region-unibyte () + (with-temp-buffer + (set-buffer-multibyte nil) + (insert "foo" #x90 #x91 #x92 "bar") + (ps-mode-octal-region (point-min) (point-max)) + (should (equal (buffer-string) + "foo\\220\\221\\222bar")))) + +(ert-deftest ps-mode-test-octal-region-multibyte () + (with-temp-buffer + (insert "foo" + (unibyte-char-to-multibyte #x90) + (unibyte-char-to-multibyte #x91) + (unibyte-char-to-multibyte #x92) + "bar") + (ps-mode-octal-region (point-min) (point-max)) + (should (equal (buffer-string) + "foo\\220\\221\\222bar")))) + +(ert-deftest ps-mode-test-indent () + ;; Converted from manual test. + (with-temp-buffer + (ps-mode) + ;; TODO: Should some of these be fontification tests as well? + (let ((orig "%!PS-2.0 + +<< 23 45 >> %dictionary +< 23 > %hex string +<~a>a%a~> %base85 string +(%)s +(sf\\(g>a)sdg) + +/foo { + << + hello 2 + 3 + >> +} def +")) + (insert orig) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + +(provide 'ps-mode-tests) + +;;; ps-mode-tests.el ends here diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index a59885637e9..fdaedb5fd7a 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -1,6 +1,6 @@ -;;; python-tests.el --- Test suite for python.el +;;; python-tests.el --- Test suite for python.el -*- lexical-binding:t -*- -;; Copyright (C) 2013-2017 Free Software Foundation, Inc. +;; Copyright (C) 2013-2022 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -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. @@ -94,6 +95,33 @@ STRING, it is skipped so the next STRING occurrence is selected." found-point (and restore-point (goto-char starting-point))))) +(defun python-tests-assert-faces (content faces) + "Assert that font faces for CONTENT are equal to FACES." + (python-tests-with-temp-buffer content + (font-lock-ensure nil nil) + (should (equal faces (python-tests-get-buffer-faces))))) + +(defun python-tests-get-buffer-faces () + "Return a list of (position . face) for each face change positions." + (cl-loop for pos = (point-min) + then (next-single-property-change pos 'face) + while pos + collect (cons pos (get-text-property pos 'face)))) + +(defun python-tests-assert-faces-after-change (content faces search replace) + "Assert that font faces for CONTENT are equal to FACES after change. +All occurrences of SEARCH are changed to REPLACE." + (python-tests-with-temp-buffer + content + ;; Force enable font-lock mode without jit-lock. + (rename-buffer "*python-font-lock-test*" t) + (let (noninteractive font-lock-support-mode) + (font-lock-mode)) + (while + (re-search-forward search nil t) + (replace-match replace)) + (should (equal faces (python-tests-get-buffer-faces))))) + (defun python-tests-self-insert (char-or-str) "Call `self-insert-command' for chars in CHAR-OR-STR." (let ((chars @@ -118,7 +146,6 @@ Argument MIN and MAX delimit the region to be returned and default to `point-min' and `point-max' respectively." (let* ((min (or min (point-min))) (max (or max (point-max))) - (buffer (current-buffer)) (buffer-contents (buffer-substring-no-properties min max)) (overlays (sort (overlays-in min max) @@ -134,6 +161,16 @@ default to `point-min' and `point-max' respectively." (overlay-end overlay)))) (buffer-substring-no-properties (point-min) (point-max))))) +(defun python-virt-bin (&optional virt-root) + "Return the virtualenv bin dir, starting from VIRT-ROOT. +If nil, VIRT-ROOT defaults to `python-shell-virtualenv-root'. +The name of this directory depends on `system-type'." + (expand-file-name + (concat + (file-name-as-directory (or virt-root + python-shell-virtualenv-root)) + (if (eq system-type 'windows-nt) "Scripts" "bin")))) + ;;; Tests for your tests, so you can test while you test. @@ -144,7 +181,7 @@ default to `point-min' and `point-max' respectively." sed do eiusmod tempor incididunt ut labore et dolore magna aliqua." (let ((expected (save-excursion - (dotimes (i 3) + (dotimes (_ 3) (re-search-forward "et" nil t)) (forward-char -2) (point)))) @@ -153,7 +190,7 @@ aliqua." ;; one should be returned. (should (= (python-tests-look-at "et" 6 t) expected)) ;; If already looking at STRING, it should skip it. - (dotimes (i 2) (re-search-forward "et")) + (dotimes (_ 2) (re-search-forward "et")) (forward-char -2) (should (= (python-tests-look-at "et") expected))))) @@ -168,7 +205,7 @@ aliqua." (re-search-forward "et" nil t) (forward-char -2) (point)))) - (dotimes (i 3) + (dotimes (_ 3) (re-search-forward "et" nil t)) (should (= (python-tests-look-at "et" -3 t) expected)) (should (= (python-tests-look-at "et" -6 t) expected))))) @@ -184,7 +221,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)) @@ -192,10 +228,435 @@ aliqua." (should (string= (buffer-string) "\"\"")) (should (null (nth 3 (syntax-ppss)))))) +(ert-deftest python-font-lock-keywords-level-1-1 () + (python-tests-assert-faces + "def func():" + '((1 . font-lock-keyword-face) (4) + (5 . font-lock-function-name-face) (9)))) + +(ert-deftest python-font-lock-keywords-level-1-2 () + "Invalid function name should not be font-locked." + (python-tests-assert-faces + "def 1func():" + '((1 . font-lock-keyword-face) (4)))) + +(ert-deftest python-font-lock-keywords-level-1-3 () + (python-tests-assert-faces + "def \\ + func():" + '((1 . font-lock-keyword-face) (4) + (15 . font-lock-function-name-face) (19)))) + +(ert-deftest python-font-lock-assignment-statement-1 () + (python-tests-assert-faces + "a, b, c = 1, 2, 3" + '((1 . font-lock-variable-name-face) (2) + (4 . font-lock-variable-name-face) (5) + (7 . font-lock-variable-name-face) (8)))) + +(ert-deftest python-font-lock-assignment-statement-2 () + (python-tests-assert-faces + "a, *b, c = 1, 2, 3, 4, 5" + '((1 . font-lock-variable-name-face) (2) + (5 . font-lock-variable-name-face) (6) + (8 . font-lock-variable-name-face) (9)))) + +(ert-deftest python-font-lock-assignment-statement-3 () + (python-tests-assert-faces + "[a, b] = (1, 2)" + '((1) + (2 . font-lock-variable-name-face) (3) + (5 . font-lock-variable-name-face) (6)))) + +(ert-deftest python-font-lock-assignment-statement-4 () + (python-tests-assert-faces + "(l[1], l[2]) = (10, 11)" + '((1) + (2 . font-lock-variable-name-face) (3) + (8 . font-lock-variable-name-face) (9)))) + +(ert-deftest python-font-lock-assignment-statement-5 () + (python-tests-assert-faces + "(a, b, c, *d) = *x, y = 5, 6, 7, 8, 9" + '((1) + (2 . font-lock-variable-name-face) (3) + (5 . font-lock-variable-name-face) (6) + (8 . font-lock-variable-name-face) (9) + (12 . font-lock-variable-name-face) (13) + (18 . font-lock-variable-name-face) (19) + (21 . font-lock-variable-name-face) (22)))) + +(ert-deftest python-font-lock-assignment-statement-6 () + (python-tests-assert-faces + "(a,) = 'foo'," + '((1) + (2 . font-lock-variable-name-face) (3) + (8 . font-lock-string-face) (13)))) + +(ert-deftest python-font-lock-assignment-statement-7 () + (python-tests-assert-faces + "(*a,) = ['foo', 'bar', 'baz']" + '((1) + (3 . font-lock-variable-name-face) (4) + (10 . font-lock-string-face) (15) + (17 . font-lock-string-face) (22) + (24 . font-lock-string-face) (29)))) + +(ert-deftest python-font-lock-assignment-statement-8 () + (python-tests-assert-faces + "d = D('a', ['b'], 'c')" + '((1 . font-lock-variable-name-face) (2) + (7 . font-lock-string-face) (10) + (13 . font-lock-string-face) (16) + (19 . font-lock-string-face) (22)))) + +(ert-deftest python-font-lock-assignment-statement-9 () + (python-tests-assert-faces + "d.x, d.y[0], *d.z = 'a', 'b', 'c', 'd', 'e'" + '((1) + (3 . font-lock-variable-name-face) (4) + (8 . font-lock-variable-name-face) (9) + (17 . font-lock-variable-name-face) (18) + (21 . font-lock-string-face) (24) + (26 . font-lock-string-face) (29) + (31 . font-lock-string-face) (34) + (36 . font-lock-string-face) (39) + (41 . font-lock-string-face)))) + +(ert-deftest python-font-lock-assignment-statement-10 () + (python-tests-assert-faces + "a: int = 5" + '((1 . font-lock-variable-name-face) (2) + (4 . font-lock-builtin-face) (7)))) + +(ert-deftest python-font-lock-assignment-statement-11 () + (python-tests-assert-faces + "b: Tuple[Optional[int], Union[Sequence[str], str]] = (None, 'foo')" + '((1 . font-lock-variable-name-face) (2) + (19 . font-lock-builtin-face) (22) + (40 . font-lock-builtin-face) (43) + (46 . font-lock-builtin-face) (49) + (55 . font-lock-constant-face) (59) + (61 . font-lock-string-face) (66)))) + +(ert-deftest python-font-lock-assignment-statement-12 () + (python-tests-assert-faces + "c: Collection = {1, 2, 3}" + '((1 . font-lock-variable-name-face) (2)))) + +(ert-deftest python-font-lock-assignment-statement-13 () + (python-tests-assert-faces + "d: Mapping[int, str] = {1: 'bar', 2: 'baz'}" + '((1 . font-lock-variable-name-face) (2) + (12 . font-lock-builtin-face) (15) + (17 . font-lock-builtin-face) (20) + (28 . font-lock-string-face) (33) + (38 . font-lock-string-face) (43)))) + +(ert-deftest python-font-lock-assignment-statement-14 () + (python-tests-assert-faces + "(a) = 5; (b) = 6" + '((1) + (2 . font-lock-variable-name-face) (3) + (11 . font-lock-variable-name-face) (12)))) + +(ert-deftest python-font-lock-assignment-statement-15 () + (python-tests-assert-faces + "[a] = 5,; [b] = 6," + '((1) + (2 . font-lock-variable-name-face) (3) + (12 . font-lock-variable-name-face) (13)))) + +(ert-deftest python-font-lock-assignment-statement-16 () + (python-tests-assert-faces + "[*a] = 5, 6; [*b] = 7, 8" + '((1) + (3 . font-lock-variable-name-face) (4) + (16 . font-lock-variable-name-face) (17)))) + +(ert-deftest python-font-lock-assignment-statement-17 () + (python-tests-assert-faces + "(a) = (b) = 1" + `((1) + (2 . font-lock-variable-name-face) (3) + (8 . font-lock-variable-name-face) (9)))) + +(ert-deftest python-font-lock-assignment-statement-18 () + (python-tests-assert-faces + "CustomInt = int + +def f(x: CustomInt) -> CustomInt: + y = x + 1 + ys: Sequence[CustomInt] = [y, y + 1] + res: CustomInt = sum(ys) + 1 + return res +" + '((1 . font-lock-variable-name-face) (10) + (13 . font-lock-builtin-face) (16) + (18 . font-lock-keyword-face) (21) + (22 . font-lock-function-name-face) (23) + (56 . font-lock-variable-name-face) (57) + (70 . font-lock-variable-name-face) (72) + (111 . font-lock-variable-name-face) (114) + (128 . font-lock-builtin-face) (131) + (144 . font-lock-keyword-face) (150)))) + +(ert-deftest python-font-lock-assignment-statement-multiline-1 () + (python-tests-assert-faces-after-change + " +[ + a, + b +] # ( + 1, + 2 +) +" + '((1) + (8 . font-lock-variable-name-face) (9) + (15 . font-lock-variable-name-face) (16)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-2 () + (python-tests-assert-faces-after-change + " +[ + *a +] # 5, 6 +" + '((1) + (9 . font-lock-variable-name-face) (10)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-3 () + (python-tests-assert-faces-after-change + "a\\ + ,\\ + b\\ + ,\\ + c\\ + #\\ + 1\\ + ,\\ + 2\\ + ,\\ + 3" + '((1 . font-lock-variable-name-face) (2) + (15 . font-lock-variable-name-face) (16) + (29 . font-lock-variable-name-face) (30)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-4 () + (python-tests-assert-faces-after-change + "a\\ + :\\ + int\\ + #\\ + 5" + '((1 . font-lock-variable-name-face) (2) + (15 . font-lock-builtin-face) (18)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-5 () + (python-tests-assert-faces-after-change + "(\\ + a\\ +)\\ + #\\ + 5\\ + ;\\ + (\\ + b\\ + )\\ + #\\ + 6" + '((1) + (8 . font-lock-variable-name-face) (9) + (46 . font-lock-variable-name-face) (47)) + "#" "=")) + +(ert-deftest python-font-lock-assignment-statement-multiline-6 () + (python-tests-assert-faces-after-change + "( + a +)\\ + #\\ + 5\\ + ;\\ + ( + b + )\\ + #\\ + 6" + '((1) + (7 . font-lock-variable-name-face) (8) + (43 . font-lock-variable-name-face) (44)) + "#" "=")) + +(ert-deftest python-font-lock-escape-sequence-string-newline () + (python-tests-assert-faces + "'\\n' +\"\\n\" +f'\\n' +f\"\\n\" +u'\\n' +u\"\\n\"" + '((1 . font-lock-doc-face) + (2 . font-lock-constant-face) + (4 . font-lock-doc-face) (5) + (6 . font-lock-doc-face) + (7 . font-lock-constant-face) + (9 . font-lock-doc-face) (10) + (12 . font-lock-string-face) + (13 . font-lock-constant-face) + (15 . font-lock-string-face) (16) + (18 . font-lock-string-face) + (19 . font-lock-constant-face) + (21 . font-lock-string-face) (22) + (24 . font-lock-string-face) + (25 . font-lock-constant-face) + (27 . font-lock-string-face) (28) + (30 . font-lock-string-face) + (31 . font-lock-constant-face) + (33 . font-lock-string-face)))) + +(ert-deftest python-font-lock-escape-sequence-multiline-string () + (python-tests-assert-faces + (let ((escape-sequences "\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}")) + (cl-loop for string-prefix in '("" "f" "rf" "fr" "r" "rb" "br" "b") + concat (cl-loop for quote-string in '("\"\"\"" "'''") + concat (concat string-prefix + quote-string + escape-sequences + quote-string + "\n")))) + '((1 . font-lock-doc-face) + (4 . font-lock-constant-face) + (8 . font-lock-doc-face) + (11 . font-lock-constant-face) + (13 . font-lock-doc-face) + (14 . font-lock-constant-face) + (20 . font-lock-doc-face) + (21 . font-lock-constant-face) + (31 . font-lock-doc-face) + (32 . font-lock-constant-face) + (51 . font-lock-doc-face) (54) + (55 . font-lock-doc-face) + (58 . font-lock-constant-face) + (62 . font-lock-doc-face) + (65 . font-lock-constant-face) + (67 . font-lock-doc-face) + (68 . font-lock-constant-face) + (74 . font-lock-doc-face) + (75 . font-lock-constant-face) + (85 . font-lock-doc-face) + (86 . font-lock-constant-face) + (105 . font-lock-doc-face) (108) + (110 . font-lock-string-face) + (113 . font-lock-constant-face) + (117 . font-lock-string-face) + (120 . font-lock-constant-face) + (122 . font-lock-string-face) + (123 . font-lock-constant-face) + (129 . font-lock-string-face) + (130 . font-lock-constant-face) + (140 . font-lock-string-face) + (141 . font-lock-constant-face) + (160 . font-lock-string-face) (163) + (165 . font-lock-string-face) + (168 . font-lock-constant-face) + (172 . font-lock-string-face) + (175 . font-lock-constant-face) + (177 . font-lock-string-face) + (178 . font-lock-constant-face) + (184 . font-lock-string-face) + (185 . font-lock-constant-face) + (195 . font-lock-string-face) + (196 . font-lock-constant-face) + (215 . font-lock-string-face) (218) + (221 . font-lock-string-face) (254) + (271 . font-lock-string-face) (274) + (277 . font-lock-string-face) (310) + (327 . font-lock-string-face) (330) + (333 . font-lock-string-face) (366) + (383 . font-lock-string-face) (386) + (389 . font-lock-string-face) (422) + (439 . font-lock-string-face) (442) + (444 . font-lock-string-face) (497) + (499 . font-lock-string-face) (552) + (555 . font-lock-string-face) (608) + (611 . font-lock-string-face) (664) + (667 . font-lock-string-face) (720) + (723 . font-lock-string-face) (776) + (778 . font-lock-string-face) + (781 . font-lock-constant-face) + (785 . font-lock-string-face) + (788 . font-lock-constant-face) + (790 . font-lock-string-face) (831) + (833 . font-lock-string-face) + (836 . font-lock-constant-face) + (840 . font-lock-string-face) + (843 . font-lock-constant-face) + (845 . font-lock-string-face) (886)))) + +(ert-deftest python-font-lock-escape-sequence-bytes-newline () + (python-tests-assert-faces + "b'\\n' +b\"\\n\"" + '((1) + (2 . font-lock-doc-face) + (3 . font-lock-constant-face) + (5 . font-lock-doc-face) (6) + (8 . font-lock-doc-face) + (9 . font-lock-constant-face) + (11 . font-lock-doc-face)))) + +(ert-deftest python-font-lock-escape-sequence-hex-octal () + (python-tests-assert-faces + "b'\\x12 \\777 \\1\\23' +'\\x12 \\777 \\1\\23'" + '((1) + (2 . font-lock-doc-face) + (3 . font-lock-constant-face) + (7 . font-lock-doc-face) + (8 . font-lock-constant-face) + (12 . font-lock-doc-face) + (13 . font-lock-constant-face) + (18 . font-lock-doc-face) (19) + (20 . font-lock-doc-face) + (21 . font-lock-constant-face) + (25 . font-lock-doc-face) + (26 . font-lock-constant-face) + (30 . font-lock-doc-face) + (31 . font-lock-constant-face) + (36 . font-lock-doc-face)))) + +(ert-deftest python-font-lock-escape-sequence-unicode () + (python-tests-assert-faces + "b'\\u1234 \\U00010348 \\N{Plus-Minus Sign}' +'\\u1234 \\U00010348 \\N{Plus-Minus Sign}'" + '((1) + (2 . font-lock-doc-face) (41) + (42 . font-lock-doc-face) + (43 . font-lock-constant-face) + (49 . font-lock-doc-face) + (50 . font-lock-constant-face) + (60 . font-lock-doc-face) + (61 . font-lock-constant-face) + (80 . font-lock-doc-face)))) + +(ert-deftest python-font-lock-raw-escape-sequence () + (python-tests-assert-faces + "rb'\\x12 \123 \\n' +r'\\x12 \123 \\n \\u1234 \\U00010348 \\N{Plus-Minus Sign}'" + '((1) + (3 . font-lock-doc-face) (14) + (16 . font-lock-doc-face)))) + ;;; Indentation -;; See: http://www.python.org/dev/peps/pep-0008/#indentation +;; See: https://www.python.org/dev/peps/pep-0008/#indentation (ert-deftest python-indent-pep8-1 () "First pep8 case." @@ -260,6 +721,19 @@ foo = long_function_name( (should (eq (car (python-indent-context)) :inside-paren-newline-start)) (should (= (python-indent-calculate-indentation) 4)))) +(ert-deftest python-indent-hanging-close-paren () + "Like first pep8 case, but with hanging close paren." ;; See Bug#20742. + (python-tests-with-temp-buffer + "\ +foo = long_function_name(var_one, var_two, + var_three, var_four + ) +" + (should (= (python-indent-calculate-indentation) 0)) + (python-tests-look-at ")") + (should (eq (car (python-indent-context)) :inside-paren-at-closing-paren)) + (should (= (python-indent-calculate-indentation) 25)))) + (ert-deftest python-indent-base-case () "Check base case does not trigger errors." (python-tests-with-temp-buffer @@ -317,7 +791,7 @@ def func(arg): # I don't do much return arg # This comment is badly indented because the user forced so. - # At this line python.el wont dedent, user is always right. + # At this line python.el won't dedent, user is always right. comment_wins_over_ender = True @@ -336,7 +810,7 @@ comment_wins_over_ender = True ;; The return keyword do make indentation lose a level... (should (= (python-indent-calculate-indentation) 0)) ;; ...but the current indentation was forced by the user. - (python-tests-look-at "# At this line python.el wont dedent") + (python-tests-look-at "# At this line python.el won't dedent") (should (eq (car (python-indent-context)) :after-comment)) (should (= (python-indent-calculate-indentation) 4)) ;; Should behave the same for blank lines: potentially a comment. @@ -780,6 +1254,25 @@ def delete_all_things(): :after-backslash-dotted-continuation)) (should (= (python-indent-calculate-indentation) 16)))) +(ert-deftest python-indent-after-backslash-6 () + "Backslash continuation from for block." + (python-tests-with-temp-buffer + " +for long_variable_name \\ + in (1, 2): + print(long_variable_name) +" + (python-tests-look-at "for long_variable_name \\") + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (python-tests-look-at "in (1, 2):") + (should (eq (car (python-indent-context)) + :after-backslash-block-continuation)) + (should (= (python-indent-calculate-indentation) 8)) + (python-tests-look-at "print(long_variable_name)") + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4)))) + (ert-deftest python-indent-block-enders-1 () "Test de-indentation for pass keyword." (python-tests-with-temp-buffer @@ -921,6 +1414,35 @@ if save: (python-indent-line t) (should (= (python-indent-calculate-indentation t) 8)))) +(ert-deftest python-indent-dedenters-comment-else () + "Test de-indentation for the else keyword with comments before it." + (python-tests-with-temp-buffer + " +if save: + try: + write_to_disk(data) + except IOError: + msg = 'Error saving to disk' + message(msg) + logger.exception(msg) + except Exception: + if hide_details: + logger.exception('Unhandled exception') + # comment + else + finally: + data.free() +" + (python-tests-look-at "else\n") + (should (eq (car (python-indent-context)) :at-dedenter-block-start)) + (should (= (python-indent-calculate-indentation) 8)) + (python-indent-line t) + (should (= (python-indent-calculate-indentation t) 4)) + (python-indent-line t) + (should (= (python-indent-calculate-indentation t) 0)) + (python-indent-line t) + (should (= (python-indent-calculate-indentation t) 8)))) + (ert-deftest python-indent-dedenters-3 () "Test de-indentation for the except keyword." (python-tests-with-temp-buffer @@ -1109,6 +1631,37 @@ def fn(a, b, c=True): (should (eq (car (python-indent-context)) :inside-string)) (should (= (python-indent-calculate-indentation) 4)))) +(ert-deftest python-indent-electric-comma-inside-multiline-string () + "Test indentation ...." + (python-tests-with-temp-buffer + " +a = ( + '''\ +- foo, +- bar +''' +" + (python-tests-look-at "- bar") + (should (eq (car (python-indent-context)) :inside-string)) + (goto-char (pos-eol)) + (python-tests-self-insert ",") + (should (= (current-indentation) 0)))) + +(ert-deftest python-indent-electric-comma-after-multiline-string () + "Test indentation ...." + (python-tests-with-temp-buffer + " +a = ( + '''\ +- foo, +- bar''' +" + (python-tests-look-at "- bar'''") + (should (eq (car (python-indent-context)) :inside-string)) + (goto-char (pos-eol)) + (python-tests-self-insert ",") + (should (= (current-indentation) 0)))) + (ert-deftest python-indent-electric-colon-1 () "Test indentation case from Bug#18228." (python-tests-with-temp-buffer @@ -1119,7 +1672,7 @@ def a(): def b() " (python-tests-look-at "def b()") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ":") (should (= (current-indentation) 0)))) @@ -1130,10 +1683,13 @@ def b() if do: something() else +outside " (python-tests-look-at "else") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ":") + (should (= (current-indentation) 0)) + (python-tests-look-at "outside") (should (= (current-indentation) 0)))) (ert-deftest python-indent-electric-colon-3 () @@ -1147,7 +1703,7 @@ if do: that) " (python-tests-look-at "that)") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ":") (python-tests-look-at "elif" -1) (should (= (current-indentation) 0)) @@ -1172,7 +1728,7 @@ def f(): else " (python-tests-look-at "else") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (python-tests-self-insert ":") (python-tests-look-at "else" -1) (should (= (current-indentation) 4)))) @@ -1293,6 +1849,60 @@ this is an arbitrarily (should (string= (buffer-substring-no-properties (point-min) (point-max)) expected))))) +(ert-deftest python-indent-after-match-block () + "Test PEP634 match." + (python-tests-with-temp-buffer + " +match foo: +" + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (goto-char (point-max)) + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4)))) + +(ert-deftest python-indent-after-case-block () + "Test PEP634 case." + (python-tests-with-temp-buffer + " +match foo: + case 1: +" + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (goto-char (point-max)) + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 8)))) + + +;;; Filling + +(ert-deftest python-auto-fill-docstring () + (python-tests-with-temp-buffer + "\ +def some_function(arg1, + arg2): + \"\"\" + Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua." + (auto-fill-mode +1) + (goto-char (point-max)) + (newline) + (search-backward "Lorem") + (let ((docindent (current-indentation))) + (forward-line 1) + (should (= docindent (current-indentation)))))) + +(ert-deftest python-fill-docstring () + (python-tests-with-temp-buffer + "\ +r'''aaa + +this is a test this is a test this is a test this is a test this is a test this is a test. +'''" + (search-forward "test.") + (fill-paragraph) + (should (= (current-indentation) 0)))) + ;;; Mark @@ -1378,7 +1988,7 @@ class C: (expected-mark-beginning-position (progn (python-tests-look-at "def __init__(self):") - (1- (line-beginning-position)))) + (1- (pos-bol)))) (expected-mark-end-position-1 (save-excursion (python-tests-look-at "self.b = 'b'") @@ -1435,7 +2045,7 @@ class C: (progn (python-tests-look-at "def fun(self):") (python-tests-look-at "(self):") - (1- (line-beginning-position)))) + (1- (pos-bol)))) (expected-mark-end-position (save-excursion (python-tests-look-at "return self.b") @@ -1447,6 +2057,57 @@ class C: (should (= (marker-position (mark-marker)) expected-mark-end-position))))) +(ert-deftest python-mark-defun-4 () + "Test `python-mark-defun' with nested functions." + (python-tests-with-temp-buffer + " +def foo(x): + def bar(): + return x + if True: + return bar +" + (let ((expected-mark-beginning-position + (progn + (python-tests-look-at "def foo(x):") + (1- (pos-bol)))) + (expected-mark-end-position (point-max))) + (python-tests-look-at "return bar") + (python-mark-defun 1) + (should (= (point) expected-mark-beginning-position)) + (should (= (marker-position (mark-marker)) + expected-mark-end-position))))) + +(ert-deftest python-mark-defun-5 () + "Test `python-mark-defun' with point inside backslash escaped defun." + (python-tests-with-temp-buffer + " +def \\ + foo(x): + return x +" + (let ((transient-mark-mode t) + (expected-mark-beginning-position + (progn + (python-tests-look-at "def ") + (1- (pos-bol)))) + (expected-mark-end-position + (save-excursion + (python-tests-look-at "return x") + (forward-line) + (point)))) + (python-tests-look-at "def ") + (python-mark-defun 1) + (should (= (point) expected-mark-beginning-position)) + (should (= (marker-position (mark-marker)) + expected-mark-end-position)) + (deactivate-mark) + (python-tests-look-at "foo(x)") + (python-mark-defun 1) + (should (= (point) expected-mark-beginning-position)) + (should (= (marker-position (mark-marker)) + expected-mark-end-position))))) + ;;; Navigation @@ -1473,12 +2134,20 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3): return wrapped_f return wwrap " - (python-tests-look-at "return wrap") + (python-tests-look-at "return wwrap") + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def decoratorFunctionWithArguments" -1) + (beginning-of-line) + (point)))) + (python-tests-look-at "return wrap" -1) (should (= (save-excursion (python-nav-beginning-of-defun) (point)) (save-excursion - (python-tests-look-at "def wrapped_f(*args):" -1) + (python-tests-look-at "def wwrap(f):" -1) (beginning-of-line) (point)))) (python-tests-look-at "def wrapped_f(*args):" -1) @@ -1512,6 +2181,9 @@ class C(object): def a(): pass + if True: + return a + def c(self): pass " @@ -1524,7 +2196,25 @@ class C(object): (python-tests-look-at "def m(self):" -1) (beginning-of-line) (point)))) + ;; Nested defuns should be skipped. + (forward-line -1) + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def m(self):" -1) + (beginning-of-line) + (point)))) ;; Defuns on same levels should be respected. + (python-tests-look-at "if True:" -1) + (forward-line -1) + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def a():" -1) + (beginning-of-line) + (point)))) (python-tests-look-at "def a():" -1) (should (= (save-excursion (python-nav-beginning-of-defun) @@ -1533,7 +2223,7 @@ class C(object): (python-tests-look-at "def b():" -1) (beginning-of-line) (point)))) - ;; Jump to a top level defun. + ;; Jump to an upper level defun. (python-tests-look-at "def b():" -1) (should (= (save-excursion (python-nav-beginning-of-defun) @@ -1542,6 +2232,14 @@ class C(object): (python-tests-look-at "def m(self):" -1) (beginning-of-line) (point)))) + (forward-line -1) + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def m(self):" -1) + (beginning-of-line) + (point)))) ;; Jump to a top level defun again. (python-tests-look-at "def m(self):" -1) (should (= (save-excursion @@ -1572,6 +2270,93 @@ class C(object): (beginning-of-line) (point)))))) +(ert-deftest python-nav-beginning-of-defun-4 () + (python-tests-with-temp-buffer + " +def a(): + pass + +def \\ + b(): + return 0 + +def c(): + pass +" + (python-tests-look-at "def c():") + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def \\" -1) + (beginning-of-line) + (point)))) + (python-tests-look-at "return 0" -1) + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def \\" -1) + (beginning-of-line) + (point)))) + (python-tests-look-at "b():" -1) + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def \\" -1) + (beginning-of-line) + (point)))) + (python-tests-look-at "def a():" -1) + (should (= (save-excursion + (python-nav-beginning-of-defun -1) + (point)) + (save-excursion + (python-tests-look-at "def \\") + (beginning-of-line) + (point)))))) + +(ert-deftest python-nav-beginning-of-defun-5 () + (python-tests-with-temp-buffer + " +class C: + + def \\ + m(self): + pass +" + (python-tests-look-at "m(self):") + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def \\" -1) + (beginning-of-line) + (point)))) + (python-tests-look-at "class C:" -1) + (should (= (save-excursion + (python-nav-beginning-of-defun -1) + (point)) + (save-excursion + (python-tests-look-at "def \\") + (beginning-of-line) + (point)))))) + +(ert-deftest python-nav-beginning-of-defun-6 () + (python-tests-with-temp-buffer + " +class C: + def foo(self): + pass +" + (python-tests-look-at "self") + (should (= (save-excursion + (python-nav-beginning-of-defun) + (point)) + (save-excursion + (beginning-of-line) + (point)))))) + (ert-deftest python-nav-end-of-defun-1 () (python-tests-with-temp-buffer " @@ -1605,12 +2390,25 @@ class C(object): (point)))) (should (= (save-excursion (python-tests-look-at "def b():") + (forward-line -1) + (python-nav-end-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def c(self):") + (forward-line -1) + (point)))) + (should (= (save-excursion + (python-tests-look-at "def b():") (python-nav-end-of-defun) (point)) (save-excursion (python-tests-look-at "def b():") (forward-line 2) (point)))) + (should (not (save-excursion + (python-tests-look-at "def a():") + (forward-line -1) + (python-nav-end-of-defun)))) (should (= (save-excursion (python-tests-look-at "def c(self):") (python-nav-end-of-defun) @@ -1659,21 +2457,55 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3): (point)) (save-excursion (python-tests-look-at "return wwrap") - (line-beginning-position)))) + (pos-bol)))) (should (= (save-excursion (python-tests-look-at "def wrapped_f(*args):") (python-nav-end-of-defun) (point)) (save-excursion (python-tests-look-at "return wrapped_f") - (line-beginning-position)))) + (pos-bol)))) (should (= (save-excursion (python-tests-look-at "f(*args)") (python-nav-end-of-defun) (point)) (save-excursion (python-tests-look-at "return wrapped_f") - (line-beginning-position)))))) + (pos-bol)))))) + +(ert-deftest python-nav-end-of-defun-3 () + (python-tests-with-temp-buffer + " +def \\ + a(): + return 0 +" + (should (= (save-excursion + (python-tests-look-at "def \\") + (python-nav-end-of-defun) + (point)) + (save-excursion + (point-max)))))) + +(ert-deftest python-end-of-defun-1 () + (python-tests-with-temp-buffer + " +class C: + def a(self + ): + pass + + def b(self): + pass +" + (should (= (save-excursion + (python-tests-look-at "def a") + (end-of-defun) + (point)) + (save-excursion + (python-tests-look-at "def b") + (forward-line -1) + (point)))))) (ert-deftest python-nav-backward-defun-1 () (python-tests-with-temp-buffer @@ -1773,6 +2605,18 @@ class A(object): (should (not (python-nav-backward-defun))) (should (= point (point)))))) +(ert-deftest python-nav-backward-defun-4 () + (python-tests-with-temp-buffer + " +def \\ + a(): + return 0 +" + (goto-char (point-max)) + (should (= (save-excursion (python-nav-backward-defun)) + (python-tests-look-at "def \\" -1))) + (should (not (python-nav-backward-defun))))) + (ert-deftest python-nav-forward-defun-1 () (python-tests-with-temp-buffer " @@ -1871,6 +2715,18 @@ class A(object): (should (not (python-nav-forward-defun))) (should (= point (point)))))) +(ert-deftest python-nav-forward-defun-4 () + (python-tests-with-temp-buffer + " +def \\ + a(): + return 0 +" + (goto-char (point-min)) + (should (= (save-excursion (python-nav-forward-defun)) + (python-tests-look-at "():"))) + (should (not (python-nav-forward-defun))))) + (ert-deftest python-nav-beginning-of-statement-1 () (python-tests-with-temp-buffer " @@ -1948,14 +2804,14 @@ string (point)) (save-excursion (python-tests-look-at "789") - (line-end-position)))) + (pos-eol)))) (python-tests-look-at "v2 =") (should (= (save-excursion (python-nav-end-of-statement) (point)) (save-excursion (python-tests-look-at "value4)") - (line-end-position)))) + (pos-eol)))) (python-tests-look-at "v3 =") (should (= (save-excursion (python-nav-end-of-statement) @@ -1963,7 +2819,7 @@ string (save-excursion (python-tests-look-at "'continue previous line')") - (line-end-position)))) + (pos-eol)))) (python-tests-look-at "v4 =") (should (= (save-excursion (python-nav-end-of-statement) @@ -1973,6 +2829,12 @@ string (python-util-forward-comment -1) (point)))))) +(ert-deftest python-nav-end-of-statement-2 () + "Test the string overlap assertion (Bug#30964)." + (python-tests-with-temp-buffer + "'\n''\n" + (python-nav-end-of-statement))) + (ert-deftest python-nav-forward-statement-1 () (python-tests-with-temp-buffer " @@ -2122,6 +2984,28 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3): (point)) (python-tests-look-at "def wwrap(f):" -1))))) +(ert-deftest python-nav-beginning-of-block-2 () + (python-tests-with-temp-buffer + " +if True: + + pass +if False: + # comment + pass +" + (python-tests-look-at "if True:") + (forward-line) + (should (= (save-excursion + (python-nav-beginning-of-block) + (point)) + (python-tests-look-at "if True:" -1))) + (python-tests-look-at "# comment") + (should (= (save-excursion + (python-nav-beginning-of-block) + (point)) + (python-tests-look-at "if False:" -1))))) + (ert-deftest python-nav-end-of-block-1 () (python-tests-with-temp-buffer " @@ -2159,21 +3043,33 @@ def decoratorFunctionWithArguments(arg1, arg2, arg3): (point)) (save-excursion (python-tests-look-at "return wrapped_f") - (line-end-position)))) + (pos-eol)))) (end-of-line) (should (= (save-excursion (python-nav-end-of-block) (point)) (save-excursion (python-tests-look-at "return wrapped_f") - (line-end-position)))) + (pos-eol)))) (python-tests-look-at "f(*args)") (should (= (save-excursion (python-nav-end-of-block) (point)) (save-excursion (python-tests-look-at "print 'After f(*args)'") - (line-end-position)))))) + (pos-eol)))))) + +(ert-deftest python-nav-end-of-block-2 () + "Ensure that `python-nav-end-of-block' does not enter an infinite loop." + (python-tests-with-temp-buffer + "def + ='' + ' +\"\"\"\"\"\" + # +'' +" + (python-nav-end-of-block))) (ert-deftest python-nav-forward-block-1 () "This also accounts as a test for `python-nav-backward-block'." @@ -2217,6 +3113,22 @@ if request.user.is_authenticated(): (python-tests-look-at "if request.user.is_authenticated():" -1))))) +(ert-deftest python-nav-forward-block-2 () + (python-tests-with-temp-buffer + " +if True: + pass +" + (python-tests-look-at "if True:") + (should (not (save-excursion (python-nav-forward-block)))) + (should (not (save-excursion (python-nav-forward-block -1)))) + (forward-char) + (should (not (save-excursion (python-nav-forward-block)))) + (should (= (save-excursion (python-nav-forward-block -1)) + (progn + (end-of-line) + (python-tests-look-at "if True:" -1)))))) + (ert-deftest python-nav-forward-sexp-1 () (python-tests-with-temp-buffer " @@ -2435,11 +3347,11 @@ if x: \tabcdefg " (python-tests-look-at "abcdefg") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) "\tabcdef"))))) (ert-deftest python-indent-dedent-line-backspace-3 () @@ -2452,27 +3364,27 @@ if x: \t abcdefg " (python-tests-look-at "abcdefg") - (goto-char (line-end-position)) + (goto-char (pos-eol)) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) "\t abcdef")) (back-to-indentation) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) "\tabcdef")) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) " abcdef")) (call-interactively #'python-indent-dedent-line-backspace) (should (string= (buffer-substring-no-properties - (line-beginning-position) (line-end-position)) + (pos-bol) (pos-eol)) "abcdef"))))) (ert-deftest python-bob-infloop-avoid () @@ -2543,58 +3455,59 @@ if x: "Test `python-shell-process-environment' modification." (let* ((python-shell-process-environment '("TESTVAR1=value1" "TESTVAR2=value2")) - (process-environment (python-shell-calculate-process-environment))) - (should (equal (getenv "TESTVAR1") "value1")) - (should (equal (getenv "TESTVAR2") "value2")))) + (env (python-shell--calculate-process-environment))) + (should (equal (getenv-internal "TESTVAR1" env) "value1")) + (should (equal (getenv-internal "TESTVAR2" env) "value2")))) (ert-deftest python-shell-calculate-process-environment-2 () "Test `python-shell-extra-pythonpaths' modification." (let* ((process-environment process-environment) - (original-pythonpath (setenv "PYTHONPATH" "/path0")) + (_original-pythonpath (setenv "PYTHONPATH" "/path0")) (python-shell-extra-pythonpaths '("/path1" "/path2")) - (process-environment (python-shell-calculate-process-environment))) - (should (equal (getenv "PYTHONPATH") + (env (python-shell--calculate-process-environment))) + (should (equal (getenv-internal "PYTHONPATH" env) (concat "/path1" path-separator "/path2" path-separator "/path0"))))) (ert-deftest python-shell-calculate-process-environment-3 () "Test `python-shell-virtualenv-root' modification." (let* ((python-shell-virtualenv-root "/env") - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONHOME" "/home") (setenv "VIRTUAL_ENV") - (python-shell-calculate-process-environment)))) - (should (not (getenv "PYTHONHOME"))) - (should (string= (getenv "VIRTUAL_ENV") "/env")))) + (python-shell--calculate-process-environment)))) + (should (member "PYTHONHOME" env)) + (should (string= (getenv-internal "VIRTUAL_ENV" env) "/env")))) (ert-deftest python-shell-calculate-process-environment-4 () "Test PYTHONUNBUFFERED when `python-shell-unbuffered' is non-nil." (let* ((python-shell-unbuffered t) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED") - (python-shell-calculate-process-environment)))) - (should (string= (getenv "PYTHONUNBUFFERED") "1")))) + (python-shell--calculate-process-environment)))) + (should (string= (getenv-internal "PYTHONUNBUFFERED" env) "1")))) (ert-deftest python-shell-calculate-process-environment-5 () "Test PYTHONUNBUFFERED when `python-shell-unbuffered' is nil." (let* ((python-shell-unbuffered nil) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED") - (python-shell-calculate-process-environment)))) - (should (not (getenv "PYTHONUNBUFFERED"))))) + (python-shell--calculate-process-environment)))) + (should (not (getenv-internal "PYTHONUNBUFFERED" env))))) (ert-deftest python-shell-calculate-process-environment-6 () "Test PYTHONUNBUFFERED=1 when `python-shell-unbuffered' is nil." (let* ((python-shell-unbuffered nil) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED" "1") - (python-shell-calculate-process-environment)))) + (append (python-shell--calculate-process-environment) + process-environment)))) ;; User default settings must remain untouched: - (should (string= (getenv "PYTHONUNBUFFERED") "1")))) + (should (string= (getenv-internal "PYTHONUNBUFFERED" env) "1")))) (ert-deftest python-shell-calculate-process-environment-7 () "Test no side-effects on `process-environment'." @@ -2604,7 +3517,7 @@ if x: (python-shell-unbuffered t) (python-shell-extra-pythonpaths'("/path1" "/path2")) (original-process-environment (copy-sequence process-environment))) - (python-shell-calculate-process-environment) + (python-shell--calculate-process-environment) (should (equal process-environment original-process-environment)))) (ert-deftest python-shell-calculate-process-environment-8 () @@ -2617,7 +3530,7 @@ if x: (python-shell-extra-pythonpaths'("/path1" "/path2")) (original-process-environment (copy-sequence tramp-remote-process-environment))) - (python-shell-calculate-process-environment) + (python-shell--calculate-process-environment) (should (equal tramp-remote-process-environment original-process-environment)))) (ert-deftest python-shell-calculate-exec-path-1 () @@ -2633,7 +3546,7 @@ if x: (python-shell-virtualenv-root "/env") (new-exec-path (python-shell-calculate-exec-path))) (should (equal new-exec-path - (list (expand-file-name "/env/bin") "/path0"))))) + (list (python-virt-bin) "/path0"))))) (ert-deftest python-shell-calculate-exec-path-3 () "Test complete `python-shell-virtualenv-root' modification." @@ -2642,7 +3555,7 @@ if x: (python-shell-virtualenv-root "/env") (new-exec-path (python-shell-calculate-exec-path))) (should (equal new-exec-path - (list (expand-file-name "/env/bin") + (list (python-virt-bin) "/path1" "/path2" "/path0"))))) (ert-deftest python-shell-calculate-exec-path-4 () @@ -2653,7 +3566,7 @@ if x: (python-shell-virtualenv-root "/env") (new-exec-path (python-shell-calculate-exec-path))) (should (equal new-exec-path - (list (expand-file-name "/env/bin") + (list (python-virt-bin) "/path1" "/path2" "/path0"))))) (ert-deftest python-shell-calculate-exec-path-5 () @@ -2683,29 +3596,49 @@ if x: (python-shell-virtualenv-root "/env")) (python-shell-with-environment (should (equal exec-path - (list (expand-file-name "/env/bin") + (list (python-virt-bin) "/path1" "/path2" "/path0"))) (should (not (getenv "PYTHONHOME"))) (should (string= (getenv "VIRTUAL_ENV") "/env"))) (should (equal exec-path original-exec-path)))) +(defun python--tests-process-env-canonical (pe) + ;; `process-environment' can contain various entries for the same + ;; var, and the first in the list hides the others. + (let ((process-environment '())) + (dolist (x (reverse pe)) + (if (string-match "=" x) + (setenv (substring x 0 (match-beginning 0)) + (substring x (match-end 0))) + (setenv x nil))) + process-environment)) + +(defun python--tests-process-env-eql (pe1 pe2) + (equal (python--tests-process-env-canonical pe1) + (python--tests-process-env-canonical pe2))) + (ert-deftest python-shell-with-environment-2 () "Test environment with remote `default-directory'." (let* ((default-directory "/ssh::/example/dir/") (python-shell-remote-exec-path '("/remote1" "/remote2")) (python-shell-exec-path '("/path1" "/path2")) (tramp-remote-process-environment '("EMACS=t")) - (original-process-environment (copy-sequence tramp-remote-process-environment)) + (original-process-environment + (copy-sequence tramp-remote-process-environment)) (python-shell-virtualenv-root "/env")) (python-shell-with-environment (should (equal (python-shell-calculate-exec-path) - (list (expand-file-name "/env/bin") + (list (python-virt-bin) "/path1" "/path2" "/remote1" "/remote2"))) - (let ((process-environment (python-shell-calculate-process-environment))) + (let ((process-environment + (append (python-shell--calculate-process-environment) + tramp-remote-process-environment))) (should (not (getenv "PYTHONHOME"))) (should (string= (getenv "VIRTUAL_ENV") "/env")) - (should (equal tramp-remote-process-environment process-environment)))) - (should (equal tramp-remote-process-environment original-process-environment)))) + (should (python--tests-process-env-eql + tramp-remote-process-environment process-environment)))) + (should (equal tramp-remote-process-environment + original-process-environment)))) (ert-deftest python-shell-with-environment-3 () "Test `python-shell-with-environment' is idempotent." @@ -2714,11 +3647,14 @@ if x: (python-shell-virtualenv-root "/home/user/env") (single-call (python-shell-with-environment - (list exec-path process-environment))) + (list exec-path + (python--tests-process-env-canonical process-environment)))) (nested-call (python-shell-with-environment (python-shell-with-environment - (list exec-path process-environment))))) + (list exec-path + (python--tests-process-env-canonical + process-environment)))))) (should (equal single-call nested-call)))) (ert-deftest python-shell-make-comint-1 () @@ -3388,10 +4324,7 @@ def foo(): (should (string= (python-shell-buffer-substring (python-tests-look-at "print ('a')") (point-max)) - "if True: - - print ('a') -")))) + "# -*- coding: utf-8 -*-\nif True:\n print ('a')\n\n")))) (ert-deftest python-shell-buffer-substring-11 () "Check substring from partial block and point within indentation." @@ -3406,10 +4339,7 @@ def foo(): (backward-char 1) (point)) (point-max)) - "if True: - - print ('a') -")))) + "# -*- coding: utf-8 -*-\nif True:\n print ('a')\n\n")))) (ert-deftest python-shell-buffer-substring-12 () "Check substring from partial block and point in whitespace." @@ -3424,13 +4354,7 @@ def foo(): (should (string= (python-shell-buffer-substring (python-tests-look-at "# Whitespace") (point-max)) - "if True: - - - # Whitespace - - print ('a') -")))) + "# -*- coding: utf-8 -*-\n\nif True:\n # Whitespace\n\n print ('a')\n\n")))) @@ -3462,7 +4386,7 @@ def foo(): ;;; Code check -;;; Eldoc +;;; ElDoc (ert-deftest python-eldoc--get-symbol-at-point-1 () "Test paren handling." @@ -3473,11 +4397,11 @@ map(codecs.open('somefile' " (python-tests-look-at "ap(xx") (should (string= (python-eldoc--get-symbol-at-point) "map")) - (goto-char (line-end-position)) + (goto-char (pos-eol)) (should (string= (python-eldoc--get-symbol-at-point) "map")) (python-tests-look-at "('somefile'") (should (string= (python-eldoc--get-symbol-at-point) "map")) - (goto-char (line-end-position)) + (goto-char (pos-eol)) (should (string= (python-eldoc--get-symbol-at-point) "codecs.open")))) (ert-deftest python-eldoc--get-symbol-at-point-2 () @@ -3990,7 +4914,7 @@ def long_function_name( (should (not (python-info-beginning-of-statement-p))) (python-tests-look-at "print (var_one)") (should (python-info-beginning-of-statement-p)) - (goto-char (line-beginning-position)) + (goto-char (pos-bol)) (should (not (python-info-beginning-of-statement-p))))) (ert-deftest python-info-beginning-of-statement-p-2 () @@ -4010,7 +4934,7 @@ if width == 0 and height == 0 and \\ (should (not (python-info-beginning-of-statement-p))) (python-tests-look-at "raise ValueError(") (should (python-info-beginning-of-statement-p)) - (goto-char (line-beginning-position)) + (goto-char (pos-bol)) (should (not (python-info-beginning-of-statement-p))))) (ert-deftest python-info-end-of-statement-p-1 () @@ -4828,6 +5752,69 @@ def decorat0r(deff): (python-tests-look-at "deff()") (should (not (python-info-looking-at-beginning-of-defun))))) +(ert-deftest python-info-looking-at-beginning-of-defun-2 () + (python-tests-with-temp-buffer + " +def \\ + foo(arg): + pass +" + (python-tests-look-at "def \\") + (should (python-info-looking-at-beginning-of-defun)) + (should (python-info-looking-at-beginning-of-defun nil t)) + (python-tests-look-at "foo(arg):") + (should (not (python-info-looking-at-beginning-of-defun))) + (should (python-info-looking-at-beginning-of-defun nil t)) + (python-tests-look-at "pass") + (should (not (python-info-looking-at-beginning-of-defun))) + (should (not (python-info-looking-at-beginning-of-defun nil t))))) + +(ert-deftest python-info-looking-at-beginning-of-defun-3 () + (python-tests-with-temp-buffer + " +def foo(arg=\"default\"): # Comment + pass +" + (python-tests-look-at "arg") + (should (python-info-looking-at-beginning-of-defun)) + (python-tests-look-at "default") + (should (python-info-looking-at-beginning-of-defun)) + (python-tests-look-at "Comment") + (should (python-info-looking-at-beginning-of-defun)))) + +(ert-deftest python-info-looking-at-beginning-of-block-1 () + (python-tests-with-temp-buffer + " +def f(): + if True: + pass + l = [x * 2 + for x in range(5) + if x < 3] +# if False: +\"\"\" +if 0: +\"\"\" +" + (python-tests-look-at "def f():") + (should (python-info-looking-at-beginning-of-block)) + (forward-char) + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if True:") + (should (python-info-looking-at-beginning-of-block)) + (forward-char) + (should (not (python-info-looking-at-beginning-of-block))) + (beginning-of-line) + (should (python-info-looking-at-beginning-of-block)) + (python-tests-look-at "for x") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if x < 3") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if False:") + (should (not (python-info-looking-at-beginning-of-block))) + (python-tests-look-at "if 0:") + (should (not (python-info-looking-at-beginning-of-block))))) + (ert-deftest python-info-current-line-comment-p-1 () (python-tests-with-temp-buffer " @@ -5192,7 +6179,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 @@ -5219,6 +6206,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 @@ -5254,8 +6268,11 @@ class SomeClass: class SomeClass: def __init__(self, arg, kwarg=1): + def filter(self, nums): - def __str__(self):")))) + + def __str__(self): +")))) (or enabled (hs-minor-mode -1))))) (ert-deftest python-hideshow-hide-levels-2 () @@ -5301,17 +6318,186 @@ class SomeClass: ")))) (or enabled (hs-minor-mode -1))))) +(ert-deftest python-hideshow-hide-levels-3 () + "Should hide all blocks." + (python-tests-with-temp-buffer + " +def f(): + if 0: + l = [i for i in range(5) + if i < 3] + abc = o.match(1, 2, 3) + +def g(): + pass +" + (hs-minor-mode 1) + (hs-hide-level 1) + (should + (string= + (python-tests-visible-string) + " +def f(): + +def g(): +")))) + +(ert-deftest python-hideshow-hide-levels-4 () + "Should hide 2nd level block." + (python-tests-with-temp-buffer + " +def f(): + if 0: + l = [i for i in range(5) + if i < 3] + abc = o.match(1, 2, 3) + +def g(): + pass +" + (hs-minor-mode 1) + (hs-hide-level 2) + (should + (string= + (python-tests-visible-string) + " +def f(): + if 0: + +def g(): + pass +")))) + +(ert-deftest python-hideshow-hide-all-1 () + "Should hide all blocks." + (python-tests-with-temp-buffer + "if 0: + + aaa + l = [i for i in range(5) + if i < 3] + ccc + abc = o.match(1, 2, 3) + ddd + +def f(): + pass +" + (hs-minor-mode 1) + (hs-hide-all) + (should + (string= + (python-tests-visible-string) + "if 0: + +def f(): +")))) + +(ert-deftest python-hideshow-hide-all-2 () + "Should hide comments." + (python-tests-with-temp-buffer + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +" + (hs-minor-mode 1) + (hs-hide-all) + (should + (string= + (python-tests-visible-string) + " +# Multi line + +\"\"\" +# Multi line +# string +\"\"\" +")))) + +(ert-deftest python-hideshow-hide-all-3 () + "Should not hide comments when `hs-hide-comments-when-hiding-all' is nil." + (python-tests-with-temp-buffer + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +" + (hs-minor-mode 1) + (let ((hs-hide-comments-when-hiding-all nil)) + (hs-hide-all)) + (should + (string= + (python-tests-visible-string) + " +# Multi line +# comment + +\"\"\" +# Multi line +# string +\"\"\" +")))) + +(ert-deftest python-hideshow-hide-block-1 () + "Should hide current block." + (python-tests-with-temp-buffer + " +if 0: + + aaa + l = [i for i in range(5) + if i < 3] + ccc + abc = o.match(1, 2, 3) + ddd + +def f(): + pass +" + (hs-minor-mode 1) + (python-tests-look-at "ddd") + (forward-line) + (hs-hide-block) + (should + (string= + (python-tests-visible-string) + " +if 0: + +def f(): + pass +")))) + (ert-deftest python-tests--python-nav-end-of-statement--infloop () "Checks that `python-nav-end-of-statement' doesn't infloop in a buffer with overlapping strings." + ;; FIXME: The treatment of strings has changed in the mean time, and the + ;; test below now neither signals an error nor inf-loops. + ;; The description of the problem it's trying to catch is not clear enough + ;; to be able to see if the underlying problem is really fixed, sadly. + ;; E.g. I don't know what is meant by "overlap", really. + :tags '(:unstable) (python-tests-with-temp-buffer "''' '\n''' ' '\n" (syntax-propertize (point-max)) ;; Create a situation where strings nominally overlap. This ;; shouldn't happen in practice, but apparently it can happen when ;; a package calls `syntax-ppss' in a narrowed buffer during JIT ;; lock. + ;; FIXME: 4-5 is the SPC right after the opening triple quotes: why + ;; put a string-fence syntax on it? (put-text-property 4 5 'syntax-table (string-to-syntax "|")) + ;; FIXME: 8-9 is the middle quote in the closing triple quotes: + ;; it shouldn't have any syntax-table property to remove anyway! (remove-text-properties 8 9 '(syntax-table nil)) (goto-char 4) (setq-local syntax-propertize-function nil) @@ -5321,11 +6507,80 @@ buffer with overlapping strings." (python-nav-end-of-statement))) (should (eolp)))) +;; Interactively, `run-python' focuses the buffer running the +;; interpreter. +(ert-deftest python-tests--run-python-selects-window () + "Test for bug#31398. See also bug#44421 and bug#52380." + (skip-unless (executable-find python-tests-shell-interpreter)) + (let* ((buffer (process-buffer (run-python nil nil 'show))) + (window (get-buffer-window buffer))) + ;; We look at `selected-window' rather than `current-buffer' + ;; because as `(elisp)Current buffer' says, the latter will only + ;; be synchronized with the former when returning to the "command + ;; loop"; until then, `current-buffer' can change arbitrarily. + (should (eq window (selected-window))) + (pop-to-buffer (other-buffer)) + (run-python nil nil 'show) + (should (eq window (selected-window))))) + +(ert-deftest python-tests--fill-long-first-line () + (should + (equal + (with-temp-buffer + (insert "def asdf(): + \"\"\"123 123 123 123 123 123 123 123 123 123 123 123 123 SHOULDBEWRAPPED 123 123 123 123 -(provide 'python-tests) + \"\"\" + a = 1 +") + (python-mode) + (goto-char (point-min)) + (forward-line 1) + (end-of-line) + (fill-paragraph) + (buffer-substring-no-properties (point-min) (point-max))) + "def asdf(): + \"\"\"123 123 123 123 123 123 123 123 123 123 123 123 123 + SHOULDBEWRAPPED 123 123 123 123 + + \"\"\" + a = 1 +"))) -;; Local Variables: -;; indent-tabs-mode: nil -;; End: + +;;; Flymake + +(ert-deftest python-tests--flymake-command-output-pattern () + (pcase-let ((`(,patt ,line ,col ,type ,msg) + python-flymake-command-output-pattern)) + ;; Pyflakes output as of version 2.4.0 + (let ((output "<stdin>:12:34 'a.b.c as d' imported but unused")) + (string-match patt output) + (should (equal (match-string line output) "12")) + (when col (should (equal (match-string col output) "34"))) + (should (equal (match-string msg output) + "'a.b.c as d' imported but unused"))) + ;; Flake8 output as of version 4.0.1 + (let ((output "stdin:12:34: F401 'a.b.c as d' imported but unused")) + (string-match patt output) + (should (equal (match-string line output) "12")) + (when col (should (equal (match-string col output) "34"))) + (when type (should (equal (match-string type output) "F401"))) + (should (equal (match-string msg output) + (if type + "'a.b.c as d' imported but unused" + "F401 'a.b.c as d' imported but unused")))) + ;; Pylint output as of version 2.14.5 + (let ((output "stdin:12:34: W0611: Unused import a.b.c (unused-import)")) + (string-match patt output) + (should (equal (match-string line output) "12")) + (when col (should (equal (match-string col output) "34"))) + (when type (should (equal (match-string type output) "W0611"))) + (should (equal (match-string msg output) + (if type + "Unused import a.b.c (unused-import)" + "W0611: Unused import a.b.c (unused-import)")))))) + +(provide 'python-tests) ;;; python-tests.el ends here diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb new file mode 100644 index 00000000000..0c206b1e0c2 --- /dev/null +++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb @@ -0,0 +1,502 @@ +if something_wrong? # ruby-move-to-block-skips-heredoc + ActiveSupport::Deprecation.warn(<<-eowarn) + boo hoo + end + eowarn + foo + + foo(<<~squiggly) + end + squiggly +end + +def foo + %^bar^ +end + +# Percent literals. +b = %Q{This is a "string"} +c = %w!foo + bar + baz! +d = %(hello (nested) world) + +# Don't propertize percent literals inside strings. +"(%s, %s)" % [123, 456] + +"abc/#{ddf}ghi" +"abc\#{ddf}ghi" + +# Or inside comments. +x = # "tot %q/to"; = + y = 2 / 3 + +# Regexp after whitelisted method. +"abc".sub /b/, 'd' + +# Don't mismatch "sub" at the end of words. +a = asub / aslb + bsub / bslb; + +# Highlight the regexp after "if". +x = toto / foo if /do bar/ =~ "dobar" + +# Regexp options are highlighted. + +/foo/xi != %r{bar}mo.tee + +foo { /"tee/ + bar { |qux| /'fee"/ } # bug#20026 +} + +bar(class: XXX) do # ruby-indent-keyword-label + foo +end +bar + +foo = [1, # ruby-deep-indent + 2] + +foo = { # ruby-deep-indent-disabled + a: b +} + +foo = { a: b, + a1: b1 + } + +foo({ # bug#16118 + a: b, + c: d + }) + +bar = foo( + a, [ + 1, + ], + :qux => [ + 3 + ]) + +foo( + [ + { + a: b + }, + ], + { + c: d + } +) + +foo([{ + a: 2 + }, + { + b: 3 + }, + 4 + ]) + +foo = [ # ruby-deep-indent-disabled + 1 +] + +foo( # ruby-deep-indent-disabled + a +) + +# Multiline regexp. +/bars + tees # toots + nfoos::/ + +def test1(arg) + puts "hello" +end + +def test2 (arg) + a = "apple" + + if a == 2 + puts "hello" + else + puts "there" + end + + if a == 2 then + puts "hello" + elsif a == 3 + puts "hello3" + elsif a == 3 then + puts "hello3" + else + puts "there" + end + + b = case a + when "a" + 6 + # Support for this syntax was removed in Ruby 1.9, so we + # probably don't need to handle it either. + # when "b" : + # 7 + # when "c" : 2 + when "d" then 4 + else 5 + end +end + +# Some Cucumber code: +Given /toto/ do + print "hello" +end + +# Bug#15208 +if something == :== + do_something + + return false unless method == :+ + x = y + z # Bug#16609 + + a = 1 ? 2 :( + 2 + 3 + ) +end + +# Bug#17097 +if x == :!= + something +end + +qux :+, + bar, + :[]=, + bar, + :a + +b = $: +c = ?? + +# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html +d = 4 + 5 + # no '\' needed + 6 + 7 + +# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html +e = 8 + 9 \ + + 10 # '\' needed + +foo = obj.bar { |m| tee(m) } + + obj.qux { |m| hum(m) } + +begin + foo +ensure + bar +end + +# Bug#15369 +MSG = 'Separate every 3 digits in the integer portion of a number' \ + 'with underscores(_).' + +class C + def foo + self.end + D.new.class + end + + def begin + end +end + +a = foo(j, k) - + bar_tee + +while a < b do # "do" is optional + foo +end + +desc "foo foo" \ + "bar bar" + +foo. + bar + +# https://github.com/rails/rails/blob/17f5d8e062909f1fcae25351834d8e89967b645e/activesupport/lib/active_support/time_with_zone.rb#L206 +foo # comment intended to confuse the tokenizer + .bar + +z = { + foo: { + a: "aaa", + b: "bbb" + } +} + +foo if + bar + +fail "stuff" \ + unless all_fine? + +if foo? + bar +end + +method arg1, # bug#15594 + method2 arg2, + arg3 + +method? arg1, + arg2 + +method! arg1, + arg2 + +method !arg1, + arg2 + +method [], + arg2 + +method :foo, + :bar + +method (a + b), + c, :d => :e, + f: g + +desc "abc", + defg + +it "is a method call with block" do |asd| + foo +end + +it("is too!") { + bar + .qux +} + +and_this_one(has) { |block, parameters| + tee +} + +if foo && + bar +end + +foo + + bar + +foo and + bar + +foo > bar && + tee < qux + +zux do + foo == bar && + tee == qux + + a = 3 and + b = 4 +end + +foo + bar == + tee + qux + +1 .. 2 && + 3 + +3 < 4 + + 5 + +10 << 4 ^ + 20 + +100 + 2 >> + 3 + +2 ** 10 / + 2 + +foo ^ + bar + +foo_bar_tee(1, 2, 3) + .qux&.bar + .tee.bar + &.tee + +foo do + bar + .tee +end + +def bar + foo + .baz +end + +abc(foo + .bar, + tee + .qux) + +# https://stackoverflow.com/questions/17786563/emacs-ruby-mode-if-expressions-indentation +tee = if foo + bar + else + tee + end + +a = b { + c +} + +aa = bb do + cc +end + +foo :bar do + qux +end + +foo do |*args| + tee +end + +bar do |&block| + tee +end + +foo = [1, 2, 3].map do |i| + i + 1 +end + +bar.foo do + bar +end + +bar.foo(tee) do + bar +end + +bar.foo(tee) { + bar +} + +bar 1 do + foo 2 do + tee + end +end + +foo | + bar + +def qux + foo ||= begin + bar + tee + rescue + oomph + end +end + +private def foo + bar +end + +%^abc^ +ddd + +qux = foo.fee ? + bar : + tee + +zoo.keep.bar!( + {x: y, + z: t}) + +zoo + .lose( + q, p) + +a.records().map(&:b).zip( + foo) + +foo1 = + subject.update( + 1 + ) + +foo2 = + subject. + update( + 2 + ) + +# FIXME: This is not consistent with the example below it, but this +# offset only happens if the colon is at eol, which wouldn't be often. +# Tokenizing `bar:' as `:bar =>' would be better, but it's hard to +# distinguish from a variable reference inside a ternary operator. +foo(bar: + tee) + +foo(:bar => + tee) + +regions = foo( + OpenStruct.new(id: 0, name: "foo") => [ + 10 + ] +) + +{'a' => { + 'b' => 'c', + 'd' => %w(e f) + } +} + +# Bug#17050 + +return render json: { + errors: { base: [message] }, + copying: copying + }, + status: 400 + +top test( + some, + top, + test) + +foo bar, { + tee: qux + } + +# Bug#42846, bug#18644 + +:foo= +# indent here +2 = 3 +:foo= if true +{:abc=>4} # not indented, and '=' is not highlighted + +# Pattern matching +case translation +in ['th', orig_text, 'en', trans_text] + puts "English translation: #{orig_text} => #{trans_text}" +in {'th' => orig_text, 'ja' => trans_text} + puts "Japanese translation: #{orig_text} => #{trans_text}" +end + +# Tokenizing "**" and "|" separately. +def resolve(**args) + members = proc do |**args| + p(**args) + end + + member.call(**args) +end diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index aa177e31b46..33fded5a59b 100644 --- a/test/lisp/progmodes/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el @@ -1,6 +1,6 @@ -;;; ruby-mode-tests.el --- Test suite for ruby-mode +;;; ruby-mode-tests.el --- Test suite for ruby-mode -*- lexical-binding:t -*- -;; Copyright (C) 2012-2017 Free Software Foundation, Inc. +;; Copyright (C) 2012-2022 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -22,6 +22,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'ruby-mode) (defmacro ruby-with-temp-buffer (contents &rest body) @@ -31,6 +32,13 @@ (ruby-mode) ,@body)) +(defmacro ruby-with-temp-file (contents &rest body) + `(ruby-with-temp-buffer ,contents + (set-visited-file-name "ruby-mode-tests") + ,@body + (set-buffer-modified-p nil) + (delete-file buffer-file-name))) + (defun ruby-should-indent (content column) "Assert indentation COLUMN on the last line of CONTENT." (ruby-with-temp-buffer content @@ -349,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 }" @@ -369,7 +377,11 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby-with-temp-buffer "foo {|b|\n}" (beginning-of-line) (ruby-toggle-block) - (should (string= "foo do |b|\nend" (buffer-string))))) + (should (string= "foo do |b|\nend" (buffer-string)))) + (ruby-with-temp-buffer "foo {|b| b }" + (beginning-of-line) + (ruby-toggle-block) + (should (string= "foo do |b|\n b\nend" (buffer-string))))) (ert-deftest ruby-toggle-block-to-brace () (let ((pairs '((17 . "foo { |b| b + 2 }") @@ -395,6 +407,13 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby-toggle-block) (should (string= "foo { \"#{bar}\" }" (buffer-string))))) +(ert-deftest ruby-toggle-block-to-brace-no-space () + (ruby-with-temp-buffer "foo do |b|\n b + 2\nend" + (beginning-of-line) + (let (ruby-toggle-block-space-before-parameters) + (ruby-toggle-block)) + (should (string= "foo {|b| b + 2 }" (buffer-string))))) + (ert-deftest ruby-recognize-symbols-starting-with-at-character () (ruby-assert-face ":@abc" 3 font-lock-constant-face)) @@ -492,7 +511,8 @@ VALUES-PLIST is a list with alternating index and value elements." (ert-deftest ruby-add-log-current-method-examples () (let ((pairs '(("foo" . "#foo") ("C.foo" . ".foo") - ("self.foo" . ".foo")))) + ("self.foo" . ".foo") + ("<<" . "#<<")))) (dolist (pair pairs) (let ((name (car pair)) (value (cdr pair))) @@ -705,17 +725,109 @@ VALUES-PLIST is a list with alternating index and value elements." (ert-deftest ruby-forward-sexp-skips-method-calls-with-keyword-names () (ruby-with-temp-buffer ruby-sexp-test-example - (goto-line 2) - (ruby-forward-sexp) + (goto-char (point-min)) + (forward-line 1) + (forward-sexp) (should (= 8 (line-number-at-pos))))) (ert-deftest ruby-backward-sexp-skips-method-calls-with-keyword-names () (ruby-with-temp-buffer ruby-sexp-test-example - (goto-line 8) + (goto-char (point-min)) + (forward-line 7) (end-of-line) - (ruby-backward-sexp) + (backward-sexp) (should (= 2 (line-number-at-pos))))) +(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-no-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do + |end") + (search-backward "do\n") + (forward-sexp) + (should (eobp)))) + +(ert-deftest ruby-backward-sexp-jumps-do-end-block-with-no-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do + |end") + (goto-char (point-max)) + (backward-sexp) + (should (looking-at "do$")))) + +(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-empty-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do || + |end") + (search-backward "do ") + (forward-sexp) + (should (eobp)))) + +(ert-deftest ruby-backward-sexp-jumps-do-end-block-with-empty-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do || + |end") + (goto-char (point-max)) + (backward-sexp) + (should (looking-at "do ")))) + +(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do |a,b| + |end") + (search-backward "do ") + (forward-sexp) + (should (eobp)))) + +(ert-deftest ruby-backward-sexp-jumps-do-end-block-with-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do |a,b| + |end") + (goto-char (point-max)) + (backward-sexp) + (should (looking-at "do ")))) + +(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-any-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do |*| + |end") + (search-backward "do ") + (forward-sexp) + (should (eobp)))) + +(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-expanded-one-arg () + (ruby-with-temp-buffer + (ruby-test-string + "proc do |a,| + |end") + (search-backward "do ") + (forward-sexp) + (should (eobp)))) + +(ert-deftest ruby-forward-sexp-jumps-do-end-block-with-one-and-any-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do |a,*| + |end") + (search-backward "do ") + (forward-sexp) + (should (eobp)))) + +(ert-deftest ruby-backward-sexp-jumps-do-end-block-with-one-and-any-args () + (ruby-with-temp-buffer + (ruby-test-string + "proc do |a,*| + |end") + (goto-char (point-max)) + (backward-sexp) + (should (looking-at "do ")))) + (ert-deftest ruby-toggle-string-quotes-quotes-correctly () (let ((pairs '(("puts '\"foo\"\\''" . "puts \"\\\"foo\\\"'\"") @@ -746,6 +858,89 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby--insert-coding-comment "utf-8") (should (string= "# encoding: utf-8\n\n" (buffer-string)))))) +(ert-deftest ruby--set-encoding-when-ascii () + (ruby-with-temp-file "ascii" + (let ((ruby-encoding-magic-comment-style 'ruby) + (ruby-insert-encoding-magic-comment t)) + (setq save-buffer-coding-system 'us-ascii) + (ruby-mode-set-encoding) + (should (string= "ascii" (buffer-string)))))) + +(ert-deftest ruby--set-encoding-when-utf8 () + (ruby-with-temp-file "💎" + (let ((ruby-encoding-magic-comment-style 'ruby) + (ruby-insert-encoding-magic-comment t)) + (setq save-buffer-coding-system 'utf-8) + (ruby-mode-set-encoding) + (should (string= "💎" (buffer-string)))))) + +(ert-deftest ruby--set-encoding-when-latin-15 () + (ruby-with-temp-file "Ⓡ" + (let ((ruby-encoding-magic-comment-style 'ruby) + (ruby-insert-encoding-magic-comment t)) + (setq save-buffer-coding-system 'iso-8859-15) + (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. + (let ((buf (find-file-noselect (ert-resource-file "ruby.rb")))) + (unwind-protect + (with-current-buffer buf + (let ((orig (buffer-string))) + (indent-region (point-min) (point-max)) + (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) diff --git a/test/lisp/progmodes/scheme-tests.el b/test/lisp/progmodes/scheme-tests.el new file mode 100644 index 00000000000..b36e85c770d --- /dev/null +++ b/test/lisp/progmodes/scheme-tests.el @@ -0,0 +1,50 @@ +;;; scheme-tests.el --- Test suite for scheme.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020-2022 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 'ert) +(require 'scheme) + +(ert-deftest scheme-test-indent () + ;; FIXME: Look into what is the expected indent here and fix it. + :expected-result :failed + ;; Converted from manual test. + (with-temp-buffer + (scheme-mode) + ;; TODO: Should some of these be fontification tests as well? + (let ((orig "#!/usr/bin/scheme is this a comment? + +;; This one is a comment +(a) +#| and this one as #|well|# as this! |# +(b) +(cons #;(this is a + comment) + head tail) +")) + (insert orig) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig))))) + +(provide 'scheme-tests) + +;;; scheme-tests.el ends here diff --git a/test/lisp/progmodes/sh-script-resources/sh-indents.erts b/test/lisp/progmodes/sh-script-resources/sh-indents.erts new file mode 100644 index 00000000000..1f92610b3aa --- /dev/null +++ b/test/lisp/progmodes/sh-script-resources/sh-indents.erts @@ -0,0 +1,40 @@ +Code: + (lambda () + (shell-script-mode) + (indent-region (point-min) (point-max))) + +Name: sh-indents1 + +=-= +if test;then + something +fi +other +=-=-= + +Name: sh-indents2 + +=-= +if test; then + something +fi +other +=-=-= + +Name: sh-indents3 + +=-= +if test ; then + something +fi +other +=-=-= + +Name: sh-indents4 + +=-= +if test ;then + something +fi +other +=-=-= diff --git a/test/lisp/progmodes/sh-script-tests.el b/test/lisp/progmodes/sh-script-tests.el new file mode 100644 index 00000000000..5d01cc1c226 --- /dev/null +++ b/test/lisp/progmodes/sh-script-tests.el @@ -0,0 +1,72 @@ +;;; sh-script-tests.el --- Tests for sh-script.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2022 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) +(require 'ert-x) + +(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 +} +")))) + +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "sh-indents.erts"))) + +(defun test-sh-back (string &optional pos) + (with-temp-buffer + (shell-script-mode) + (insert string) + (sh-smie--default-backward-token) + (= (point) (or pos 1)))) + +(ert-deftest test-backward-token () + (should (test-sh-back "foo")) + (should (test-sh-back "foo.bar")) + (should (test-sh-back "foo\\1bar")) + (should (test-sh-back "foo\\\nbar")) + (should (test-sh-back "foo\\\n\\\n\\\nbar")) + (should (test-sh-back "foo")) + (should-not (test-sh-back "foo;bar")) + (should (test-sh-back "foo#zot"))) + +;;; sh-script-tests.el ends here diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index ad22906ecf1..c644d115df6 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -1,6 +1,6 @@ ;;; sql-tests.el --- Tests for sql.el -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2022 Free Software Foundation, Inc. ;; Author: Simen Heggestøyl <simenheg@gmail.com> ;; Keywords: @@ -28,6 +28,7 @@ (require 'cl-lib) (require 'ert) +(require 'ert-x) (require 'sql) (ert-deftest sql-tests-postgres-list-databases () @@ -50,8 +51,459 @@ (lambda (_command) t)) ((symbol-function 'process-lines) (lambda (_program &rest _args) - (error)))) + (error "Some error")))) (should-not (sql-postgres-list-databases)))) +;;; Check Connection Password Handling/Wallet + +(defvar sql-test-login-params nil) +(defmacro with-sql-test-connect-harness (id login-params connection expected) + "Set-up and tear-down SQL connect related test. + +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)) + `(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'." + (with-sql-test-connect-harness 1 (user password server database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-password "test-1 aPassword") + (sql-server "aServer") + (sql-database "aDatabase")) + "(sqltest nil \"aUserName\" \"test-1 aPassword\" \"aServer\" \"aDatabase\")\n")) + +(ert-deftest sql-test-connect-password-func () + "Test of password function." + (with-sql-test-connect-harness 2 (user password server database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-password (lambda () (concat [?t ?e ?s ?t ?- ?2 ?\s + ?a ?P ?a ?s ?s ?w ?o ?r ?d]))) + (sql-server "aServer") + (sql-database "aDatabase")) + "(sqltest nil \"aUserName\" \"test-2 aPassword\" \"aServer\" \"aDatabase\")\n")) + +(ert-deftest sql-test-connect-wallet-server-database () + "Test of password function." + (with-sql-test-connect-harness 3 (user password server database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-server "aServer") + (sql-database "aDatabase")) + "(sqltest nil \"aUserName\" \"netrc-G aPassword\" \"aServer\" \"aDatabase\")\n")) + +(ert-deftest sql-test-connect-wallet-database () + "Test of password function." + (with-sql-test-connect-harness 4 (user password database) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-database "aDatabase")) + "(sqltest nil \"aUserName\" \"netrc-E aPassword\" nil \"aDatabase\")\n")) + +(ert-deftest sql-test-connect-wallet-server () + "Test of password function." + (with-sql-test-connect-harness 5 (user password server) + ((sql-product 'sqltest) + (sql-user "aUserName") + (sql-server "aServer")) + "(sqltest nil \"aUserName\" \"netrc-B aPassword\" \"aServer\" nil)\n")) + +;;; Set/Get Product Features + +(defvar sql-test-feature-value-a nil "Indirect value A.") +(defvar sql-test-feature-value-b nil "Indirect value B.") +(defvar sql-test-feature-value-c nil "Indirect value C.") +(defvar sql-test-feature-value-d nil "Indirect value D.") +(defmacro sql-test-product-feature-harness (&rest action) + "Set-up and tear-down of testing product/feature API. + +Perform ACTION and validate results" + (declare (indent 2)) + `(cl-letf + ((sql-product-alist + (list (list 'a :X 1 :Y 2 :Z 'sql-test-feature-value-a) + (list 'b :X 3 :Z 'sql-test-feature-value-b) + (list 'c :Y 6 :Z 'sql-test-feature-value-c) + (list 'd :X 7 :Y 8 ))) + (sql-indirect-features '(:Z :W)) + (sql-test-feature-value-a "original A") + (sql-test-feature-value-b "original B") + (sql-test-feature-value-c "original C") + (sql-test-feature-value-d "original D")) + ,@action)) + +(ert-deftest sql-test-add-product () + "Add a product" + + (sql-test-product-feature-harness + (sql-add-product 'xyz "XyzDb") + + (should (equal (pp-to-string (assoc 'xyz sql-product-alist)) + "(xyz :name \"XyzDb\")\n"))) + + (sql-test-product-feature-harness + (sql-add-product 'stu "StuDb" :X 1 :Y "2") + + (should (equal (pp-to-string (assoc 'stu sql-product-alist)) + "(stu :name \"StuDb\" :X 1 :Y \"2\")\n")))) + +(ert-deftest sql-test-add-existing-product () + "Add a product that already exists." + + (sql-test-product-feature-harness + (should-error (sql-add-product 'a "Aaa")) + (should (equal (pp-to-string (assoc 'a sql-product-alist)) + "(a :X 1 :Y 2 :Z sql-test-feature-value-a)\n")))) + +(ert-deftest sql-test-set-feature () + "Add a feature" + + (sql-test-product-feature-harness + (sql-set-product-feature 'b :Y 4) + (should (equal (pp-to-string (assoc 'b sql-product-alist)) + "(b :Y 4 :X 3 :Z sql-test-feature-value-b)\n")))) + +(ert-deftest sql-test-set-indirect-feature () + "Set a new indirect feature" + + (sql-test-product-feature-harness + (sql-set-product-feature 'd :Z 'sql-test-feature-value-d) + (should (equal (pp-to-string (assoc 'd sql-product-alist)) + "(d :Z sql-test-feature-value-d :X 7 :Y 8)\n")))) + +(ert-deftest sql-test-set-existing-feature () + "Set an existing feature." + + (sql-test-product-feature-harness + (sql-set-product-feature 'b :X 33) + (should (equal (pp-to-string (assoc 'b sql-product-alist)) + "(b :X 33 :Z sql-test-feature-value-b)\n")))) + +(ert-deftest sql-test-set-existing-indirect-feature () + "Set an existing indirect feature." + + (sql-test-product-feature-harness + (should (equal sql-test-feature-value-b "original B")) + (sql-set-product-feature 'b :Z "Hurray!") + (should (equal (pp-to-string (assoc 'b sql-product-alist)) + "(b :X 3 :Z sql-test-feature-value-b)\n")) ;; unchanged + (should (equal sql-test-feature-value-b "Hurray!")))) + +(ert-deftest sql-test-set-missing-product () + "Add a feature to a missing product." + + (sql-test-product-feature-harness + (should-error (sql-set-product-feature 'x :Y 4)) + (should-not (assoc 'x sql-product-alist)))) + +(ert-deftest sql-test-get-feature () + "Get a feature value." + + (sql-test-product-feature-harness + (should (equal (sql-get-product-feature 'c :Y) 6)))) + +(ert-deftest sql-test-get-indirect-feature () + "Get a feature indirect value." + + (sql-test-product-feature-harness + (should (equal (sql-get-product-feature 'c :Z nil t) 'sql-test-feature-value-c)) + (should (equal sql-test-feature-value-c "original C")) + (should (equal (sql-get-product-feature 'c :Z) "original C")))) + +(ert-deftest sql-test-get-missing-product () + "Get a feature value from a missing product." + + (sql-test-product-feature-harness + (should-error (sql-get-product-feature 'x :Y)))) + +(ert-deftest sql-test-get-missing-feature () + "Get a missing feature value." + + (sql-test-product-feature-harness + (should-not (sql-get-product-feature 'c :X)))) + +(ert-deftest sql-test-get-missing-indirect-feature () + "Get a missing indirect feature value." + + (sql-test-product-feature-harness + (should-not (sql-get-product-feature 'd :Z)))) + +;;; SQL Oracle SCAN/DEFINE +(defmacro sql-tests-placeholder-filter-harness (orig repl outp) + "Set-up and tear-down of testing of placeholder filter. + +The placeholder in ORIG will be replaced by REPL which should +yield OUTP." + + (declare (indent 0)) + `(let ((syntab (syntax-table)) + (sql-oracle-scan-on t)) + (set-syntax-table sql-mode-syntax-table) + + (cl-letf + (((symbol-function 'read-from-minibuffer) + (lambda (&rest _) ,repl))) + + (should (equal (sql-placeholders-filter ,orig) ,outp))) + + (set-syntax-table syntab))) + +(ert-deftest sql-tests-placeholder-filter-simple () + "Test that placeholder relacement of simple replacement text." + (sql-tests-placeholder-filter-harness + "select '&x' from dual;" "XX" + "select 'XX' from dual;")) + +(ert-deftest sql-tests-placeholder-filter-ampersand () + "Test that placeholder relacement of replacement text with ampersand." + (sql-tests-placeholder-filter-harness + "select '&x' from dual;" "&Y" + "select '&Y' from dual;") + + (sql-tests-placeholder-filter-harness + "select '&x' from dual;" "Y&" + "select 'Y&' from dual;") + + (sql-tests-placeholder-filter-harness + "select '&x' from dual;" "Y&Y" + "select 'Y&Y' from dual;")) + +(ert-deftest sql-tests-placeholder-filter-period () + "Test that placeholder relacement of token terminated by a period." + (sql-tests-placeholder-filter-harness + "select '&x.' from dual;" "&Y" + "select '&Y' from dual;") + + (sql-tests-placeholder-filter-harness + "select '&x.y' from dual;" "&Y" + "select '&Yy' from dual;") + + (sql-tests-placeholder-filter-harness + "select '&x..y' from dual;" "&Y" + "select '&Y.y' from dual;")) + +;; Buffer naming +(defmacro sql-tests-buffer-naming-harness (product &rest action) + "Set-up and tear-down of test of buffer naming. + +The ACTION will be tested after set-up of PRODUCT." + + (declare (indent 1)) + `(progn + (ert--skip-unless (executable-find sql-sqlite-program)) + (let (new-bufs) + (cl-letf + (((symbol-function 'make-comint-in-buffer) + (lambda (_name buffer _program &optional _startfile &rest _switches) + (let ((b (get-buffer-create buffer))) + (message ">>make-comint-in-buffer %S" b) + (cl-pushnew b new-bufs) ;; Keep track of what we create + b)))) + + (let (,(intern (format "sql-%s-login-params" product))) + ,@action) + + (let (kill-buffer-query-functions) ;; Kill what we create + (mapc #'kill-buffer new-bufs)))))) + +(ert-deftest sql-tests-buffer-naming-default () + "Test buffer naming." + (sql-tests-buffer-naming-harness sqlite + (sql-sqlite) + (message ">> %S" (current-buffer)) + (should (equal (buffer-name) "*SQL: SQLite*")))) + +(ert-deftest sql-tests-buffer-naming-multiple () + "Test buffer naming of multiple buffers." + (sql-tests-buffer-naming-harness sqlite + (sql-sqlite) + (should (equal (buffer-name) "*SQL: SQLite*")) + + (switch-to-buffer "*scratch*") + + (sql-sqlite) + (should (equal (buffer-name) "*SQL: SQLite*")))) + +(ert-deftest sql-tests-buffer-naming-explicit () + "Test buffer naming with explicit name." + (sql-tests-buffer-naming-harness sqlite + (sql-sqlite "A") + (should (equal (buffer-name) "*SQL: A*")) + + (switch-to-buffer "*scratch*") + + (sql-sqlite "A") + (should (equal (buffer-name) "*SQL: A*")))) + +(ert-deftest sql-tests-buffer-naming-universal-argument () + "Test buffer naming with explicit name." + (sql-tests-buffer-naming-harness sqlite + (cl-letf + (((symbol-function 'read-string) + (lambda (_prompt &optional _initial-input _history _default-value _inherit-input-method) + "1"))) + (sql-sqlite '(4)) + (should (equal (buffer-name) "*SQL: 1*"))) + + (switch-to-buffer "*scratch*") + + (cl-letf + (((symbol-function 'read-string) + (lambda (_prompt &optional _initial-input _history _default-value _inherit-input-method) + "2"))) + (sql-sqlite '(16)) + (should (equal (buffer-name) "*SQL: 2*"))))) + +(ert-deftest sql-tests-buffer-naming-existing () + "Test buffer naming with an existing non-SQLi buffer." + (sql-tests-buffer-naming-harness sqlite + (get-buffer-create "*SQL: exist*") + + (cl-letf + (((symbol-function 'read-string) + (lambda (_prompt &optional _initial-input _history _default-value _inherit-input-method) + "exist"))) + (sql-sqlite '(4)) + (should (equal (buffer-name) "*SQL: exist-1*"))) + + (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 ""))))) + + + +;; Tests for sql-interactive-remove-continuation-prompt + +(defmacro sql-tests-remove-cont-prompts-harness (&rest body) + "Set-up and tear-down for tests of +`sql-interactive-remove-continuation-prompt'." + (declare (indent 0)) + `(let ((comint-prompt-regexp "^ +\\.\\{3\\} ") + (sql-output-newline-count nil) + (sql-preoutput-hold nil)) + ,@body + (should (null sql-output-newline-count)) + (should (null sql-preoutput-hold)))) + +(ert-deftest sql-tests-remove-cont-prompts-pass-through () + "Test that `sql-interactive-remove-continuation-prompt' just +passes the output line through when it doesn't expect prompts." + (sql-tests-remove-cont-prompts-harness + (should + (equal " ... " + (sql-interactive-remove-continuation-prompt + " ... "))))) + +(ert-deftest sql-tests-remove-cont-prompts-anchored-successive () + "Test that `sql-interactive-remove-continuation-prompt' is able +to delete multiple prompts (anchored to bol) even if they appear +in a single line, but not more than `sql-output-newline-count'." + (sql-tests-remove-cont-prompts-harness + (setq sql-output-newline-count 2) + (should + (equal + ;; 2 of 3 prompts are deleted + "some output ... more output...\n\ + ... \n\ +output after prompt" + (sql-interactive-remove-continuation-prompt + "some output ... more output...\n\ + ... ... ... \n\ +output after prompt"))))) + +(ert-deftest sql-tests-remove-cont-prompts-collect-chunked-output () + "Test that `sql-interactive-remove-continuation-prompt' properly +collects output when output arrives in chunks, with prompts +intermixed." + (sql-tests-remove-cont-prompts-harness + (setq sql-output-newline-count 2) + + ;; Part of first prompt gets held. Complete line is passed + ;; through. + (should (equal "line1\n" + (sql-interactive-remove-continuation-prompt + "line1\n .."))) + (should (equal " .." sql-preoutput-hold)) + (should (equal 2 sql-output-newline-count)) + + ;; First prompt is complete - remove it. Hold part of line2. + (should (equal "" + (sql-interactive-remove-continuation-prompt ". li"))) + (should (equal "li" sql-preoutput-hold)) + (should (equal 1 sql-output-newline-count)) + + ;; Remove second prompt. Flush output & don't hold / process any + ;; output further on. + (should (equal "line2\nli" + (sql-interactive-remove-continuation-prompt "ne2\n ... li"))) + (should (null sql-preoutput-hold)) + (should (null sql-output-newline-count)) + (should (equal "line3\n ... " + (sql-interactive-remove-continuation-prompt "line3\n ... "))))) + +(ert-deftest sql-tests-remove-cont-prompts-flush-held () + "Test that when we don't wait for prompts, + `sql-interactive-remove-continuation-prompt' just 'flushes' held + output, with no prompt processing." + (sql-tests-remove-cont-prompts-harness + (setq sql-preoutput-hold "line1\n ..") + (should (equal "line1\n ... line2 .." + (sql-interactive-remove-continuation-prompt ". line2 .."))))) + (provide 'sql-tests) ;;; sql-tests.el ends here diff --git a/test/lisp/progmodes/subword-tests.el b/test/lisp/progmodes/subword-tests.el index 66fe1472e4c..7ce27e4df4f 100644 --- a/test/lisp/progmodes/subword-tests.el +++ b/test/lisp/progmodes/subword-tests.el @@ -1,22 +1,24 @@ -;;; subword-tests.el --- Testing the subword rules +;;; subword-tests.el --- Testing the subword rules -*- lexical-binding:t -*- -;; Copyright (C) 2011-2017 Free Software Foundation, Inc. +;; Copyright (C) 2011-2022 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el new file mode 100644 index 00000000000..d2346606c27 --- /dev/null +++ b/test/lisp/progmodes/tcl-tests.el @@ -0,0 +1,86 @@ +;;; tcl-tests.el --- Test suite for tcl-mode -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2022 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 'ert) +(require 'tcl) + +;; From bug#23565 +(ert-deftest tcl-mode-beginning-of-defun-1 () + (with-temp-buffer + (tcl-mode) + (insert "proc bad {{value \"\"}} {\n # do something\n}") + (should (beginning-of-defun)) + (should (= (point) (point-min))) + (end-of-defun) + (should (= (point) (point-max))))) + +;; From bug#23565 +(ert-deftest tcl-mode-beginning-of-defun-2 () + (with-temp-buffer + (tcl-mode) + (insert "proc good {{value}} {\n # do something\n}") + (should (beginning-of-defun)) + (should (= (point) (point-min))) + (end-of-defun) + (should (= (point) (point-max))))) + +(ert-deftest tcl-mode-function-name () + (with-temp-buffer + (tcl-mode) + (insert "proc notinthis {} {\n # nothing\n}\n\n") + (should-not (add-log-current-defun)))) + +(ert-deftest tcl-mode-function-name-2 () + (with-temp-buffer + (tcl-mode) + (insert "proc simple {} {\n # nothing\n}") + (backward-char 3) + (should (equal "simple" (add-log-current-defun))))) + +(ert-deftest tcl-mode-function-name-3 () + (with-temp-buffer + (tcl-mode) + (insert "proc inthis {} {\n # nothing\n") + (should (equal "inthis" (add-log-current-defun))))) + +;; From bug#32035 +(ert-deftest tcl-mode-namespace-indent () + (with-temp-buffer + (tcl-mode) + (let ((text "namespace eval Foo {\n variable foo\n}\n")) + (insert text) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) text))))) + +;; From bug#44834 +(ert-deftest tcl-mode-namespace-indent-2 () + (with-temp-buffer + (tcl-mode) + (let ((text "namespace eval Foo {\n proc foo {} {}\n\n proc bar {}{}}\n")) + (insert text) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) text))))) + +(provide 'tcl-tests) + +;;; tcl-tests.el ends here diff --git a/test/lisp/progmodes/xref-resources/file1.txt b/test/lisp/progmodes/xref-resources/file1.txt new file mode 100644 index 00000000000..85b92f11566 --- /dev/null +++ b/test/lisp/progmodes/xref-resources/file1.txt @@ -0,0 +1,2 @@ + foo foo +bar diff --git a/test/lisp/progmodes/xref-resources/file2.txt b/test/lisp/progmodes/xref-resources/file2.txt new file mode 100644 index 00000000000..9f075f26004 --- /dev/null +++ b/test/lisp/progmodes/xref-resources/file2.txt @@ -0,0 +1,2 @@ + +bar diff --git a/test/lisp/progmodes/xref-resources/file3.txt b/test/lisp/progmodes/xref-resources/file3.txt new file mode 100644 index 00000000000..6283185910d --- /dev/null +++ b/test/lisp/progmodes/xref-resources/file3.txt @@ -0,0 +1 @@ + match some words match more match ends here diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index 465aab51128..f7af5055c78 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -1,6 +1,6 @@ -;;; xref-tests.el --- tests for xref +;;; xref-tests.el --- tests for xref -*- lexical-binding:t -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2022 Free Software Foundation, Inc. ;; Author: Dmitry Gutov <dgutov@yandex.ru> @@ -23,46 +23,80 @@ ;;; Code: +(require 'ert) (require 'xref) (require 'cl-lib) -(defvar xref-tests-data-dir - (expand-file-name "data/xref/" - (getenv "EMACS_TEST_DIRECTORY"))) +(defvar xref-tests--data-dir + (expand-file-name "xref-resources/" + (file-name-directory + (or load-file-name buffer-file-name)))) -(ert-deftest xref-collect-matches-finds-none-for-some-regexp () - (should (null (xref-collect-matches "zzz" "*" xref-tests-data-dir nil)))) +(defun xref-tests--matches-in-data-dir (regexp &optional files) + (xref-matches-in-directory regexp (or files "*") xref-tests--data-dir nil)) -(ert-deftest xref-collect-matches-finds-some-for-bar () - (let* ((matches (xref-collect-matches "bar" "*" xref-tests-data-dir nil)) - (locs (cl-sort (mapcar #'xref-item-location matches) - #'string< - :key #'xref-location-group))) - (should (= 2 (length matches))) +(defun xref-tests--locations-in-data-dir (regexp &optional files) + (let ((matches (xref-tests--matches-in-data-dir regexp files))) + ;; Sort in order to guarantee an order independent from the + ;; filesystem traversal. + (cl-sort (mapcar #'xref-item-location matches) + #'string< + :key #'xref-location-group))) + +(ert-deftest xref-matches-in-directory-finds-none-for-some-regexp () + (should (null (xref-tests--matches-in-data-dir "zzz")))) + +(ert-deftest xref-matches-in-directory-finds-some-for-bar () + (let ((locs (xref-tests--locations-in-data-dir "bar"))) + (should (= 2 (length locs))) (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-collect-matches-finds-two-matches-on-the-same-line () - (let* ((matches (xref-collect-matches "foo" "*" xref-tests-data-dir nil)) - (locs (mapcar #'xref-item-location matches))) - (should (= 2 (length matches))) +(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))) (should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 0 locs)))) (should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 1 locs)))) (should (equal 1 (xref-location-line (nth 0 locs)))) (should (equal 1 (xref-location-line (nth 1 locs)))) - (should (equal 0 (xref-file-location-column (nth 0 locs)))) - (should (equal 4 (xref-file-location-column (nth 1 locs)))))) + (should (equal 1 (xref-file-location-column (nth 0 locs)))) + (should (equal 5 (xref-file-location-column (nth 1 locs)))))) -(ert-deftest xref-collect-matches-finds-an-empty-line-regexp-match () - (let* ((matches (xref-collect-matches "^$" "*" xref-tests-data-dir nil)) - (locs (mapcar #'xref-item-location matches))) - (should (= 1 (length matches))) +(ert-deftest xref-matches-in-directory-finds-an-empty-line-regexp-match () + (let ((locs (xref-tests--locations-in-data-dir "^$"))) + (should (= 1 (length locs))) (should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 0 locs)))) (should (equal 1 (xref-location-line (nth 0 locs)))) (should (equal 0 (xref-file-location-column (nth 0 locs)))))) +(ert-deftest xref-matches-in-files-includes-matches-from-all-the-files () + (let ((matches (xref-matches-in-files "bar" + (directory-files xref-tests--data-dir t + "\\`[^.]")))) + (should (= 2 (length matches))) + (should (cl-every + (lambda (match) (equal (xref-item-summary match) "bar")) + matches)))) + +(ert-deftest xref-matches-in-files-trims-summary-for-matches-on-same-line () + (let ((matches (xref-matches-in-files "match" + (directory-files xref-tests--data-dir t + "\\`[^.]")))) + (should (= 3 (length matches))) + (should + (equal (mapcar #'xref-item-summary matches) + '(" match some words " "match more " "match ends here"))))) + (ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-1 () - (let* ((xrefs (xref-collect-matches "foo" "*" xref-tests-data-dir nil)) + (let* ((xrefs (xref-tests--matches-in-data-dir "foo")) (iter (xref--buf-pairs-iterator xrefs)) (cons (funcall iter :next))) (should (null (funcall iter :next))) @@ -70,7 +104,7 @@ (should (= 2 (length (cdr cons)))))) (ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-2 () - (let* ((xrefs (xref-collect-matches "bar" "*" xref-tests-data-dir nil)) + (let* ((xrefs (xref-tests--matches-in-data-dir "bar")) (iter (xref--buf-pairs-iterator xrefs)) (cons1 (funcall iter :next)) (cons2 (funcall iter :next))) @@ -80,7 +114,7 @@ (should (= 1 (length (cdr cons2)))))) (ert-deftest xref--buf-pairs-iterator-cleans-up-markers () - (let* ((xrefs (xref-collect-matches "bar" "*" xref-tests-data-dir nil)) + (let* ((xrefs (xref-tests--matches-in-data-dir "bar")) (iter (xref--buf-pairs-iterator xrefs)) (cons1 (funcall iter :next)) (cons2 (funcall iter :next))) @@ -89,3 +123,48 @@ (should (null (marker-position (cdr (nth 0 (cdr cons1)))))) (should (null (marker-position (car (nth 0 (cdr cons2)))))) (should (null (marker-position (cdr (nth 0 (cdr cons2)))))))) + +(ert-deftest xref--xref-file-name-display-is-abs () + (let ((xref-file-name-display 'abs)) + (should (equal + (delete-dups + (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")))))) + +(ert-deftest xref--xref-file-name-display-is-nondirectory () + (let ((xref-file-name-display 'nondirectory)) + (should (equal (delete-dups + (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"))))) + +(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))) + (xref-file-name-display 'project-relative)) + (should (equal + (delete-dups + (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"))))) + +;;; xref-tests.el ends here |