diff options
Diffstat (limited to 'test')
-rw-r--r-- | test/Makefile.in (renamed from test/automated/Makefile.in) | 82 | ||||
-rw-r--r-- | test/README | 6 | ||||
-rw-r--r-- | test/automated/abbrev-tests.el | 98 | ||||
-rw-r--r-- | test/automated/coding-tests.el | 50 | ||||
-rw-r--r-- | test/automated/core-elisp-tests.el | 52 | ||||
-rw-r--r-- | test/automated/data-tests.el | 257 | ||||
-rw-r--r-- | test/automated/help-fns.el | 70 | ||||
-rw-r--r-- | test/automated/lexbind-tests.el | 75 | ||||
-rw-r--r-- | test/automated/syntax-tests.el | 97 | ||||
-rw-r--r-- | test/automated/tramp-tests.el | 2383 | ||||
-rw-r--r-- | test/data/decompress/foo.gz (renamed from test/automated/data/decompress/foo.gz) | bin | 30 -> 30 bytes | |||
-rw-r--r-- | test/data/epg/pubkey.asc (renamed from test/automated/data/epg/pubkey.asc) | 0 | ||||
-rw-r--r-- | test/data/epg/seckey.asc (renamed from test/automated/data/epg/seckey.asc) | 0 | ||||
-rw-r--r-- | test/data/files-bug18141.el.gz (renamed from test/automated/data/files-bug18141.el.gz) | bin | 77 -> 77 bytes | |||
-rw-r--r-- | test/data/net/cert.pem | 25 | ||||
-rw-r--r-- | test/data/net/key.pem | 28 | ||||
-rw-r--r-- | test/data/shr/div-div.html | 1 | ||||
-rw-r--r-- | test/data/shr/div-div.txt | 2 | ||||
-rw-r--r-- | test/data/shr/div-p.html | 1 | ||||
-rw-r--r-- | test/data/shr/div-p.txt | 3 | ||||
-rw-r--r-- | test/data/shr/li-div.html | 10 | ||||
-rw-r--r-- | test/data/shr/li-div.txt | 6 | ||||
-rw-r--r-- | test/data/shr/li-empty.html | 1 | ||||
-rw-r--r-- | test/data/shr/li-empty.txt | 3 | ||||
-rw-r--r-- | test/data/shr/nonbr.html | 1 | ||||
-rw-r--r-- | test/data/shr/nonbr.txt | 12 | ||||
-rw-r--r-- | test/data/shr/ul-empty.html | 4 | ||||
-rw-r--r-- | test/data/shr/ul-empty.txt | 3 | ||||
-rw-r--r-- | test/data/xref/file1.txt (renamed from test/automated/data/xref/file1.txt) | 0 | ||||
-rw-r--r-- | test/data/xref/file2.txt (renamed from test/automated/data/xref/file2.txt) | 0 | ||||
-rw-r--r-- | test/file-organization.org | 51 | ||||
-rw-r--r-- | test/lisp/abbrev-tests.el | 255 | ||||
-rw-r--r-- | test/lisp/auth-source-tests.el (renamed from test/automated/auth-source-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/autorevert-tests.el (renamed from test/automated/auto-revert-tests.el) | 73 | ||||
-rw-r--r-- | test/lisp/buff-menu-tests.el | 45 | ||||
-rw-r--r-- | test/lisp/calc/calc-tests.el (renamed from test/automated/calc-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/calendar/icalendar-tests.el (renamed from test/automated/icalendar-tests.el) | 63 | ||||
-rw-r--r-- | test/lisp/calendar/parse-time-tests.el | 65 | ||||
-rw-r--r-- | test/lisp/char-fold-tests.el (renamed from test/automated/char-fold-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/comint-tests.el (renamed from test/automated/comint-testsuite.el) | 0 | ||||
-rw-r--r-- | test/lisp/dabbrev-tests.el (renamed from test/automated/dabbrev-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/descr-text-tests.el (renamed from test/automated/descr-text-test.el) | 0 | ||||
-rw-r--r-- | test/lisp/dired-tests.el | 56 | ||||
-rw-r--r-- | test/lisp/dom-tests.el | 201 | ||||
-rw-r--r-- | test/lisp/electric-tests.el (renamed from test/automated/electric-tests.el) | 1 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/bytecomp-tests.el (renamed from test/automated/bytecomp-tests.el) | 49 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/checkdoc-tests.el | 53 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/cl-generic-tests.el (renamed from test/automated/cl-generic-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/cl-lib-tests.el (renamed from test/automated/cl-lib-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/cl-seq-tests.el | 307 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el (renamed from test/automated/eieio-test-methodinvoke.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el (renamed from test/automated/eieio-test-persist.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (renamed from test/automated/eieio-tests.el) | 6 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/ert-tests.el (renamed from test/automated/ert-tests.el) | 68 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/ert-x-tests.el (renamed from test/automated/ert-x-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/generator-tests.el (renamed from test/automated/generator-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/let-alist-tests.el (renamed from test/automated/let-alist.el) | 8 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/lisp-tests.el | 307 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/map-tests.el (renamed from test/automated/map-tests.el) | 8 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/nadvice-tests.el (renamed from test/automated/advice-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/archive-contents (renamed from test/automated/data/package/archive-contents) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/key.pub (renamed from test/automated/data/package/key.pub) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/key.sec (renamed from test/automated/data/package/key.sec) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/macro-problem-package-1.0/macro-aux.el (renamed from test/automated/data/package/macro-problem-package-1.0/macro-aux.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/macro-problem-package-1.0/macro-problem.el (renamed from test/automated/data/package/macro-problem-package-1.0/macro-problem.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/macro-problem-package-2.0/macro-aux.el (renamed from test/automated/data/package/macro-problem-package-2.0/macro-aux.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/macro-problem-package-2.0/macro-problem.el (renamed from test/automated/data/package/macro-problem-package-2.0/macro-problem.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/multi-file-0.2.3.tar (renamed from test/automated/data/package/multi-file-0.2.3.tar) | bin | 20480 -> 20480 bytes | |||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/multi-file-readme.txt (renamed from test/automated/data/package/multi-file-readme.txt) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/newer-versions/archive-contents (renamed from test/automated/data/package/newer-versions/archive-contents) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el (renamed from test/automated/data/package/newer-versions/new-pkg-1.0.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el (renamed from test/automated/data/package/newer-versions/simple-single-1.4.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/package-test-server.py (renamed from test/automated/data/package/package-test-server.py) | 2 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/signed/archive-contents (renamed from test/automated/data/package/signed/archive-contents) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig (renamed from test/automated/data/package/signed/archive-contents.sig) | bin | 287 -> 287 bytes | |||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el (renamed from test/automated/data/package/signed/signed-bad-1.0.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el.sig (renamed from test/automated/data/package/signed/signed-bad-1.0.el.sig) | bin | 287 -> 287 bytes | |||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el (renamed from test/automated/data/package/signed/signed-good-1.0.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig (renamed from test/automated/data/package/signed/signed-good-1.0.el.sig) | bin | 287 -> 287 bytes | |||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el (renamed from test/automated/data/package/simple-depend-1.0.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/simple-single-1.3.el (renamed from test/automated/data/package/simple-single-1.3.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/simple-single-readme.txt (renamed from test/automated/data/package/simple-single-readme.txt) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el (renamed from test/automated/data/package/simple-two-depend-1.1.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/package-tests.el (renamed from test/automated/package-test.el) | 63 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/pcase-tests.el (renamed from test/automated/pcase-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/regexp-opt-tests.el (renamed from test/automated/regexp-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/ring-tests.el | 206 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/rx-tests.el | 37 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/seq-tests.el (renamed from test/automated/seq-tests.el) | 62 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/subr-x-tests.el (renamed from test/automated/subr-x-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/tabulated-list-test.el (renamed from test/automated/tabulated-list-test.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/thunk-tests.el (renamed from test/automated/thunk-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/timer-tests.el (renamed from test/automated/timer-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/emulation/viper-tests.el (renamed from test/automated/viper-tests.el) | 6 | ||||
-rw-r--r-- | test/lisp/epg-tests.el (renamed from test/automated/epg-tests.el) | 42 | ||||
-rw-r--r-- | test/lisp/erc/erc-track-tests.el | 122 | ||||
-rw-r--r-- | test/lisp/eshell/eshell.el (renamed from test/automated/eshell.el) | 0 | ||||
-rw-r--r-- | test/lisp/faces-tests.el (renamed from test/automated/faces-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/ffap-tests.el | 54 | ||||
-rw-r--r-- | test/lisp/filenotify-tests.el (renamed from test/automated/file-notify-tests.el) | 707 | ||||
-rw-r--r-- | test/lisp/files-tests.el (renamed from test/automated/files.el) | 79 | ||||
-rw-r--r-- | test/lisp/files-x-tests.el | 297 | ||||
-rw-r--r-- | test/lisp/gnus/gnus-tests.el (renamed from test/automated/gnus-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/gnus/message-tests.el (renamed from test/automated/message-mode-tests.el) | 43 | ||||
-rw-r--r-- | test/lisp/help-fns-tests.el | 121 | ||||
-rw-r--r-- | test/lisp/htmlfontify-tests.el | 34 | ||||
-rw-r--r-- | test/lisp/ibuffer-tests.el | 807 | ||||
-rw-r--r-- | test/lisp/imenu-tests.el (renamed from test/automated/imenu-test.el) | 0 | ||||
-rw-r--r-- | test/lisp/info-xref-tests.el (renamed from test/automated/info-xref.el) | 0 | ||||
-rw-r--r-- | test/lisp/international/mule-util-tests.el (renamed from test/automated/mule-util.el) | 0 | ||||
-rw-r--r-- | test/lisp/international/ucs-normalize-tests.el | 277 | ||||
-rw-r--r-- | test/lisp/isearch-tests.el (renamed from test/automated/isearch-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/jit-lock-tests.el | 60 | ||||
-rw-r--r-- | test/lisp/json-tests.el (renamed from test/automated/json-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/mail/rmail-tests.el (renamed from test/automated/replace-tests.el) | 28 | ||||
-rw-r--r-- | test/lisp/man-tests.el (renamed from test/automated/man-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/minibuffer-tests.el (renamed from test/automated/completion-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/mouse-tests.el | 50 | ||||
-rw-r--r-- | test/lisp/net/dbus-tests.el (renamed from test/automated/dbus-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/net/network-stream-tests.el | 294 | ||||
-rw-r--r-- | test/lisp/net/newsticker-tests.el (renamed from test/automated/newsticker-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/net/sasl-scram-rfc-tests.el (renamed from test/automated/sasl-scram-rfc-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/net/shr-tests.el | 58 | ||||
-rw-r--r-- | test/lisp/net/tramp-tests.el | 2696 | ||||
-rw-r--r-- | test/lisp/obarray-tests.el (renamed from test/automated/obarray-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/progmodes/cc-mode-tests.el | 72 | ||||
-rw-r--r-- | test/lisp/progmodes/compile-tests.el (renamed from test/automated/compile-tests.el) | 78 | ||||
-rw-r--r-- | test/lisp/progmodes/elisp-mode-tests.el (renamed from test/automated/elisp-mode-tests.el) | 85 | ||||
-rw-r--r-- | test/lisp/progmodes/etags-tests.el | 91 | ||||
-rw-r--r-- | test/lisp/progmodes/f90.el (renamed from test/automated/f90.el) | 0 | ||||
-rw-r--r-- | test/lisp/progmodes/flymake-resources/Makefile (renamed from test/automated/data/flymake/Makefile) | 0 | ||||
-rw-r--r-- | test/lisp/progmodes/flymake-resources/test.c (renamed from test/automated/data/flymake/test.c) | 0 | ||||
-rw-r--r-- | test/lisp/progmodes/flymake-resources/test.pl (renamed from test/automated/data/flymake/test.pl) | 0 | ||||
-rw-r--r-- | test/lisp/progmodes/flymake-tests.el (renamed from test/automated/flymake-tests.el) | 2 | ||||
-rw-r--r-- | test/lisp/progmodes/python-tests.el (renamed from test/automated/python-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/progmodes/ruby-mode-tests.el (renamed from test/automated/ruby-mode-tests.el) | 11 | ||||
-rw-r--r-- | test/lisp/progmodes/sql-tests.el | 47 | ||||
-rw-r--r-- | test/lisp/progmodes/subword-tests.el (renamed from test/automated/subword-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/progmodes/xref-tests.el (renamed from test/automated/xref-tests.el) | 2 | ||||
-rw-r--r-- | test/lisp/ps-print-tests.el (renamed from test/automated/cl-seq-tests.el) | 32 | ||||
-rw-r--r-- | test/lisp/replace-tests.el (renamed from test/automated/occur-tests.el) | 39 | ||||
-rw-r--r-- | test/lisp/rot13-tests.el | 54 | ||||
-rw-r--r-- | test/lisp/shell-tests.el | 33 | ||||
-rw-r--r-- | test/lisp/simple-tests.el (renamed from test/automated/simple-test.el) | 18 | ||||
-rw-r--r-- | test/lisp/sort-tests.el (renamed from test/automated/sort-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/subr-tests.el (renamed from test/automated/subr-tests.el) | 47 | ||||
-rw-r--r-- | test/lisp/textmodes/css-mode-tests.el | 222 | ||||
-rw-r--r-- | test/lisp/textmodes/reftex-tests.el (renamed from test/automated/reftex-tests.el) | 15 | ||||
-rw-r--r-- | test/lisp/textmodes/sgml-mode-tests.el (renamed from test/automated/sgml-mode-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/textmodes/tildify-tests.el (renamed from test/automated/tildify-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/thingatpt-tests.el (renamed from test/automated/thingatpt.el) | 36 | ||||
-rw-r--r-- | test/lisp/url/url-auth-tests.el | 255 | ||||
-rw-r--r-- | test/lisp/url/url-expand-tests.el (renamed from test/automated/url-expand-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/url/url-future-tests.el (renamed from test/automated/url-future-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/url/url-parse-tests.el (renamed from test/automated/url-parse-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/url/url-util-tests.el (renamed from test/automated/url-util-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/vc/add-log-tests.el (renamed from test/automated/add-log-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/vc/ediff-ptch-tests.el | 42 | ||||
-rw-r--r-- | test/lisp/vc/vc-bzr-tests.el (renamed from test/automated/vc-bzr.el) | 8 | ||||
-rw-r--r-- | test/lisp/vc/vc-hg.el (renamed from test/automated/vc-hg.el) | 0 | ||||
-rw-r--r-- | test/lisp/vc/vc-tests.el (renamed from test/automated/vc-tests.el) | 229 | ||||
-rw-r--r-- | test/lisp/whitespace-tests.el | 52 | ||||
-rw-r--r-- | test/lisp/xml-tests.el (renamed from test/automated/xml-parse-tests.el) | 0 | ||||
-rw-r--r-- | test/lisp/xt-mouse-tests.el (renamed from test/automated/xt-mouse-tests.el) | 0 | ||||
-rw-r--r-- | test/make-test-deps.emacs-lisp | 98 | ||||
-rw-r--r-- | test/manual/BidiCharacterTest.txt (renamed from test/BidiCharacterTest.txt) | 55 | ||||
-rw-r--r-- | test/manual/biditest.el (renamed from test/biditest.el) | 2 | ||||
-rw-r--r-- | test/manual/cedet/cedet-utests.el (renamed from test/cedet/cedet-utests.el) | 0 | ||||
-rw-r--r-- | test/manual/cedet/ede-tests.el (renamed from test/cedet/ede-tests.el) | 0 | ||||
-rw-r--r-- | test/manual/cedet/semantic-ia-utest.el (renamed from test/cedet/semantic-ia-utest.el) | 0 | ||||
-rw-r--r-- | test/manual/cedet/semantic-tests.el (renamed from test/cedet/semantic-tests.el) | 0 | ||||
-rw-r--r-- | test/manual/cedet/semantic-utest-c.el (renamed from test/cedet/semantic-utest-c.el) | 0 | ||||
-rw-r--r-- | test/manual/cedet/semantic-utest.el (renamed from test/cedet/semantic-utest.el) | 0 | ||||
-rw-r--r-- | test/manual/cedet/srecode-tests.el (renamed from test/cedet/srecode-tests.el) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/test.c (renamed from test/cedet/tests/test.c) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/test.el (renamed from test/cedet/tests/test.el) | 2 | ||||
-rw-r--r-- | test/manual/cedet/tests/test.make (renamed from test/cedet/tests/test.make) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testdoublens.cpp (renamed from test/cedet/tests/testdoublens.cpp) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testdoublens.hpp (renamed from test/cedet/tests/testdoublens.hpp) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testfriends.cpp (renamed from test/cedet/tests/testfriends.cpp) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testjavacomp.java (renamed from test/cedet/tests/testjavacomp.java) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testnsp.cpp (renamed from test/cedet/tests/testnsp.cpp) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testpolymorph.cpp (renamed from test/cedet/tests/testpolymorph.cpp) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testspp.c (renamed from test/cedet/tests/testspp.c) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testsppcomplete.c (renamed from test/cedet/tests/testsppcomplete.c) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testsppreplace.c (renamed from test/cedet/tests/testsppreplace.c) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testsppreplaced.c (renamed from test/cedet/tests/testsppreplaced.c) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testsubclass.cpp (renamed from test/cedet/tests/testsubclass.cpp) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testsubclass.hh (renamed from test/cedet/tests/testsubclass.hh) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testtypedefs.cpp (renamed from test/cedet/tests/testtypedefs.cpp) | 0 | ||||
-rw-r--r-- | test/manual/cedet/tests/testvarnames.c (renamed from test/cedet/tests/testvarnames.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/CTAGS.good (renamed from test/etags/CTAGS.good) | 148 | ||||
-rw-r--r-- | test/manual/etags/ETAGS.good_1 (renamed from test/etags/ETAGS.good_1) | 147 | ||||
-rw-r--r-- | test/manual/etags/ETAGS.good_2 (renamed from test/etags/ETAGS.good_2) | 171 | ||||
-rw-r--r-- | test/manual/etags/ETAGS.good_3 (renamed from test/etags/ETAGS.good_3) | 162 | ||||
-rw-r--r-- | test/manual/etags/ETAGS.good_4 (renamed from test/etags/ETAGS.good_4) | 147 | ||||
-rw-r--r-- | test/manual/etags/ETAGS.good_5 (renamed from test/etags/ETAGS.good_5) | 186 | ||||
-rw-r--r-- | test/manual/etags/ETAGS.good_6 (renamed from test/etags/ETAGS.good_6) | 186 | ||||
-rw-r--r-- | test/manual/etags/Makefile (renamed from test/etags/Makefile) | 4 | ||||
-rw-r--r-- | test/manual/etags/a-src/empty.zz (renamed from test/etags/a-src/empty.zz) | 0 | ||||
-rw-r--r-- | test/manual/etags/a-src/empty.zz.gz (renamed from test/etags/a-src/empty.zz.gz) | 0 | ||||
-rw-r--r-- | test/manual/etags/ada-src/2ataspri.adb (renamed from test/etags/ada-src/2ataspri.adb) | 0 | ||||
-rw-r--r-- | test/manual/etags/ada-src/2ataspri.ads (renamed from test/etags/ada-src/2ataspri.ads) | 0 | ||||
-rw-r--r-- | test/manual/etags/ada-src/etags-test-for.ada (renamed from test/etags/ada-src/etags-test-for.ada) | 0 | ||||
-rw-r--r-- | test/manual/etags/ada-src/waroquiers.ada (renamed from test/etags/ada-src/waroquiers.ada) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/a/b/b.c (renamed from test/etags/c-src/a/b/b.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/abbrev.c (renamed from test/etags/c-src/abbrev.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/c.c (renamed from test/etags/c-src/c.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/dostorture.c (renamed from test/etags/c-src/dostorture.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/emacs/src/gmalloc.c (renamed from test/etags/c-src/emacs/src/gmalloc.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/emacs/src/keyboard.c (renamed from test/etags/c-src/emacs/src/keyboard.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/emacs/src/lisp.h (renamed from test/etags/c-src/emacs/src/lisp.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/emacs/src/regex.h (renamed from test/etags/c-src/emacs/src/regex.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/etags.c (renamed from test/etags/c-src/etags.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/exit.c (renamed from test/etags/c-src/exit.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/exit.strange_suffix (renamed from test/etags/c-src/exit.strange_suffix) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/fail.c (renamed from test/etags/c-src/fail.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/getopt.h (renamed from test/etags/c-src/getopt.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/h.h (renamed from test/etags/c-src/h.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/machsyscalls.c (renamed from test/etags/c-src/machsyscalls.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/machsyscalls.h (renamed from test/etags/c-src/machsyscalls.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/sysdep.h (renamed from test/etags/c-src/sysdep.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/tab.c (renamed from test/etags/c-src/tab.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/c-src/torture.c (renamed from test/etags/c-src/torture.c) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/MDiagArray2.h (renamed from test/etags/cp-src/MDiagArray2.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/Range.h (renamed from test/etags/cp-src/Range.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/burton.cpp (renamed from test/etags/cp-src/burton.cpp) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/c.C (renamed from test/etags/cp-src/c.C) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/clheir.cpp.gz (renamed from test/etags/cp-src/clheir.cpp.gz) | bin | 408 -> 408 bytes | |||
-rw-r--r-- | test/manual/etags/cp-src/clheir.hpp (renamed from test/etags/cp-src/clheir.hpp) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/conway.cpp (renamed from test/etags/cp-src/conway.cpp) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/conway.hpp (renamed from test/etags/cp-src/conway.hpp) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/fail.C (renamed from test/etags/cp-src/fail.C) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/functions.cpp (renamed from test/etags/cp-src/functions.cpp) | 6 | ||||
-rw-r--r-- | test/manual/etags/cp-src/screen.cpp (renamed from test/etags/cp-src/screen.cpp) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/screen.hpp (renamed from test/etags/cp-src/screen.hpp) | 0 | ||||
-rw-r--r-- | test/manual/etags/cp-src/x.cc (renamed from test/etags/cp-src/x.cc) | 0 | ||||
-rw-r--r-- | test/manual/etags/el-src/TAGTEST.EL (renamed from test/etags/el-src/TAGTEST.EL) | 0 | ||||
-rw-r--r-- | test/manual/etags/el-src/emacs/lisp/progmodes/etags.el (renamed from test/etags/el-src/emacs/lisp/progmodes/etags.el) | 0 | ||||
-rw-r--r-- | test/manual/etags/erl-src/gs_dialog.erl (renamed from test/etags/erl-src/gs_dialog.erl) | 0 | ||||
-rw-r--r-- | test/manual/etags/f-src/entry.for (renamed from test/etags/f-src/entry.for) | 0 | ||||
-rw-r--r-- | test/manual/etags/f-src/entry.strange.gz (renamed from test/etags/f-src/entry.strange.gz) | bin | 3265 -> 3265 bytes | |||
-rw-r--r-- | test/manual/etags/f-src/entry.strange_suffix (renamed from test/etags/f-src/entry.strange_suffix) | 0 | ||||
-rw-r--r-- | test/manual/etags/forth-src/test-forth.fth (renamed from test/etags/forth-src/test-forth.fth) | 21 | ||||
-rw-r--r-- | test/manual/etags/go-src/test.go (renamed from test/etags/go-src/test.go) | 0 | ||||
-rw-r--r-- | test/manual/etags/go-src/test1.go (renamed from test/etags/go-src/test1.go) | 0 | ||||
-rw-r--r-- | test/manual/etags/html-src/algrthms.html (renamed from test/etags/html-src/algrthms.html) | 0 | ||||
-rw-r--r-- | test/manual/etags/html-src/index.shtml (renamed from test/etags/html-src/index.shtml) | 0 | ||||
-rw-r--r-- | test/manual/etags/html-src/software.html (renamed from test/etags/html-src/software.html) | 4 | ||||
-rw-r--r-- | test/manual/etags/html-src/softwarelibero.html (renamed from test/etags/html-src/softwarelibero.html) | 0 | ||||
-rw-r--r-- | test/manual/etags/lua-src/allegro.lua (renamed from test/etags/lua-src/allegro.lua) | 0 | ||||
-rw-r--r-- | test/manual/etags/lua-src/test.lua (renamed from test/etags/lua-src/test.lua) | 0 | ||||
-rw-r--r-- | test/manual/etags/make-src/Makefile (renamed from test/etags/make-src/Makefile) | 0 | ||||
-rw-r--r-- | test/manual/etags/objc-src/PackInsp.h (renamed from test/etags/objc-src/PackInsp.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/objc-src/PackInsp.m (renamed from test/etags/objc-src/PackInsp.m) | 0 | ||||
-rw-r--r-- | test/manual/etags/objc-src/Subprocess.h (renamed from test/etags/objc-src/Subprocess.h) | 0 | ||||
-rw-r--r-- | test/manual/etags/objc-src/Subprocess.m (renamed from test/etags/objc-src/Subprocess.m) | 0 | ||||
-rw-r--r-- | test/manual/etags/objcpp-src/SimpleCalc.H (renamed from test/etags/objcpp-src/SimpleCalc.H) | 0 | ||||
-rw-r--r-- | test/manual/etags/objcpp-src/SimpleCalc.M (renamed from test/etags/objcpp-src/SimpleCalc.M) | 0 | ||||
-rw-r--r-- | test/manual/etags/pas-src/common.pas (renamed from test/etags/pas-src/common.pas) | 0 | ||||
-rw-r--r-- | test/manual/etags/perl-src/htlmify-cystic (renamed from test/etags/perl-src/htlmify-cystic) | 0 | ||||
-rw-r--r-- | test/manual/etags/perl-src/kai-test.pl (renamed from test/etags/perl-src/kai-test.pl) | 0 | ||||
-rw-r--r-- | test/manual/etags/perl-src/yagrip.pl (renamed from test/etags/perl-src/yagrip.pl) | 0 | ||||
-rw-r--r-- | test/manual/etags/php-src/lce_functions.php (renamed from test/etags/php-src/lce_functions.php) | 0 | ||||
-rw-r--r-- | test/manual/etags/php-src/ptest.php (renamed from test/etags/php-src/ptest.php) | 0 | ||||
-rw-r--r-- | test/manual/etags/php-src/sendmail.php (renamed from test/etags/php-src/sendmail.php) | 0 | ||||
-rw-r--r-- | test/manual/etags/prol-src/natded.prolog (renamed from test/etags/prol-src/natded.prolog) | 0 | ||||
-rw-r--r-- | test/manual/etags/prol-src/ordsets.prolog (renamed from test/etags/prol-src/ordsets.prolog) | 0 | ||||
-rw-r--r-- | test/manual/etags/ps-src/rfc1245.ps (renamed from test/etags/ps-src/rfc1245.ps) | 0 | ||||
-rw-r--r-- | test/manual/etags/pyt-src/server.py (renamed from test/etags/pyt-src/server.py) | 0 | ||||
-rw-r--r-- | test/manual/etags/ruby-src/test.rb (renamed from test/etags/ruby-src/test.rb) | 0 | ||||
-rw-r--r-- | test/manual/etags/ruby-src/test1.ru (renamed from test/etags/ruby-src/test1.ru) | 0 | ||||
-rw-r--r-- | test/manual/etags/tex-src/gzip.texi (renamed from test/etags/tex-src/gzip.texi) | 0 | ||||
-rw-r--r-- | test/manual/etags/tex-src/nonewline.tex (renamed from test/etags/tex-src/nonewline.tex) | 0 | ||||
-rw-r--r-- | test/manual/etags/tex-src/testenv.tex (renamed from test/etags/tex-src/testenv.tex) | 0 | ||||
-rw-r--r-- | test/manual/etags/tex-src/texinfo.tex (renamed from test/etags/tex-src/texinfo.tex) | 0 | ||||
-rw-r--r-- | test/manual/etags/y-src/atest.y (renamed from test/etags/y-src/atest.y) | 0 | ||||
-rw-r--r-- | test/manual/etags/y-src/cccp.c (renamed from test/etags/y-src/cccp.c) | 76 | ||||
-rw-r--r-- | test/manual/etags/y-src/cccp.y (renamed from test/etags/y-src/cccp.y) | 0 | ||||
-rw-r--r-- | test/manual/etags/y-src/parse.c (renamed from test/etags/y-src/parse.c) | 88 | ||||
-rw-r--r-- | test/manual/etags/y-src/parse.y (renamed from test/etags/y-src/parse.y) | 0 | ||||
-rw-r--r-- | test/manual/indent/Makefile (renamed from test/indent/Makefile) | 0 | ||||
-rw-r--r-- | test/manual/indent/css-mode.css (renamed from test/indent/css-mode.css) | 0 | ||||
-rw-r--r-- | test/manual/indent/js-indent-init-dynamic.js (renamed from test/indent/js-indent-init-dynamic.js) | 0 | ||||
-rw-r--r-- | test/manual/indent/js-indent-init-t.js (renamed from test/indent/js-indent-init-t.js) | 0 | ||||
-rw-r--r-- | test/manual/indent/js-jsx.js (renamed from test/indent/js-jsx.js) | 0 | ||||
-rw-r--r-- | test/manual/indent/js.js (renamed from test/indent/js.js) | 3 | ||||
-rw-r--r-- | test/manual/indent/latex-mode.tex (renamed from test/indent/latex-mode.tex) | 0 | ||||
-rw-r--r-- | test/manual/indent/modula2.mod (renamed from test/indent/modula2.mod) | 0 | ||||
-rw-r--r-- | test/manual/indent/nxml.xml (renamed from test/indent/nxml.xml) | 0 | ||||
-rw-r--r-- | test/manual/indent/octave.m (renamed from test/indent/octave.m) | 0 | ||||
-rw-r--r-- | test/manual/indent/pascal.pas (renamed from test/indent/pascal.pas) | 0 | ||||
-rwxr-xr-x | test/manual/indent/perl.perl (renamed from test/indent/perl.perl) | 0 | ||||
-rw-r--r-- | test/manual/indent/prolog.prolog (renamed from test/indent/prolog.prolog) | 0 | ||||
-rw-r--r-- | test/manual/indent/ps-mode.ps (renamed from test/indent/ps-mode.ps) | 0 | ||||
-rw-r--r-- | test/manual/indent/ruby.rb (renamed from test/indent/ruby.rb) | 0 | ||||
-rw-r--r-- | test/manual/indent/scheme.scm (renamed from test/indent/scheme.scm) | 0 | ||||
-rw-r--r-- | test/manual/indent/scss-mode.scss (renamed from test/indent/scss-mode.scss) | 0 | ||||
-rw-r--r-- | test/manual/indent/sgml-mode-attribute.html (renamed from test/indent/sgml-mode-attribute.html) | 0 | ||||
-rwxr-xr-x | test/manual/indent/shell.rc (renamed from test/indent/shell.rc) | 0 | ||||
-rwxr-xr-x | test/manual/indent/shell.sh (renamed from test/indent/shell.sh) | 0 | ||||
-rw-r--r-- | test/manual/redisplay-testsuite.el (renamed from test/redisplay-testsuite.el) | 0 | ||||
-rw-r--r-- | test/manual/rmailmm.el (renamed from test/rmailmm.el) | 0 | ||||
-rw-r--r-- | test/src/alloc-tests.el (renamed from test/automated/finalizer-tests.el) | 2 | ||||
-rw-r--r-- | test/src/buffer-tests.el (renamed from test/automated/buffer-tests.el) | 0 | ||||
-rw-r--r-- | test/src/callproc-tests.el | 39 | ||||
-rw-r--r-- | test/src/chartab-tests.el | 51 | ||||
-rw-r--r-- | test/src/cmds-tests.el (renamed from test/automated/cmds-tests.el) | 0 | ||||
-rw-r--r-- | test/src/coding-tests.el (renamed from test/automated/decoder-tests.el) | 214 | ||||
-rw-r--r-- | test/src/data-tests.el | 452 | ||||
-rw-r--r-- | test/src/decompress-tests.el (renamed from test/automated/zlib-tests.el) | 6 | ||||
-rw-r--r-- | test/src/doc-tests.el | 92 | ||||
-rw-r--r-- | test/src/editfns-tests.el | 136 | ||||
-rw-r--r-- | test/src/eval-tests.el | 50 | ||||
-rw-r--r-- | test/src/fns-tests.el (renamed from test/automated/fns-tests.el) | 54 | ||||
-rw-r--r-- | test/src/font-tests.el (renamed from test/automated/font-parse-tests.el) | 5 | ||||
-rw-r--r-- | test/src/inotify-tests.el (renamed from test/automated/inotify-test.el) | 0 | ||||
-rw-r--r-- | test/src/keymap-tests.el (renamed from test/automated/keymap-tests.el) | 7 | ||||
-rw-r--r-- | test/src/lread-tests.el | 115 | ||||
-rw-r--r-- | test/src/marker-tests.el | 60 | ||||
-rw-r--r-- | test/src/minibuf-tests.el | 403 | ||||
-rw-r--r-- | test/src/print-tests.el (renamed from test/automated/print-tests.el) | 0 | ||||
-rw-r--r-- | test/src/process-tests.el (renamed from test/automated/process-tests.el) | 1 | ||||
-rw-r--r-- | test/src/regex-resources/BOOST.tests | 829 | ||||
-rw-r--r-- | test/src/regex-resources/PCRE.tests | 2386 | ||||
-rw-r--r-- | test/src/regex-resources/PTESTS | 341 | ||||
-rw-r--r-- | test/src/regex-resources/TESTS | 167 | ||||
-rw-r--r-- | test/src/regex-tests.el | 680 | ||||
-rw-r--r-- | test/src/textprop-tests.el (renamed from test/automated/textprop-tests.el) | 3 | ||||
-rw-r--r-- | test/src/thread-tests.el | 247 | ||||
-rw-r--r-- | test/src/undo-tests.el (renamed from test/automated/undo-tests.el) | 0 | ||||
-rw-r--r-- | test/src/xml-tests.el (renamed from test/automated/libxml-tests.el) | 0 |
332 files changed, 15391 insertions, 4956 deletions
diff --git a/test/automated/Makefile.in b/test/Makefile.in index 9c9b3be1e0b..f2f27634c24 100644 --- a/test/automated/Makefile.in +++ b/test/Makefile.in @@ -21,7 +21,8 @@ ## Some targets: ## check: re-run all tests, writing to .log files. -## check-maybe: run all tests whose .log file needs updating +## check-maybe: run all tests which are outdated with their .log file +## or the source files they are testing. ## filename.log: run tests from filename.el(c) if .log file needs updating ## filename: re-run tests from filename.el(c), with no logging @@ -32,12 +33,14 @@ SHELL = @SHELL@ srcdir = @srcdir@ VPATH = $(srcdir) +MKDIR_P = @MKDIR_P@ + SEPCHAR = @SEPCHAR@ # We never change directory before running Emacs, so a relative file # name is fine, and makes life easier. If we need to change # directory, we can use emacs --chdir. -EMACS = ../../src/emacs +EMACS = ../src/emacs EMACS_EXTRAOPT= @@ -103,22 +106,31 @@ else SELECTOR_ACTUAL=$(SELECTOR_EXPENSIVE) endif +## Byte-compile all test files to test for errors (unless explicitly +## told not to), but then evaluate the un-byte-compiled files, because +## they give cleaner stacktraces. -%.log: ${srcdir}/%.el - @if grep '^;.*no-byte-compile: t' $< > /dev/null; then \ - loadfile=$<; \ - else \ - loadfile=$<c; \ - ${MAKE} $$loadfile; \ +## Beware: it approximates 'no-byte-compile', so watch out for false-positives! +%.log: %.el + elc=$<c; \ + if ! grep '^;.*no-byte-compile: t' $< > /dev/null; then \ + ${MAKE} $$elc; \ fi; \ + loadfile=$<; \ echo Testing $$loadfile; \ stat=OK ; \ + ${MKDIR_P} $(dir $@) ; \ $(emacs) -l ert -l $$loadfile \ --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} -ELFILES = $(sort $(wildcard ${srcdir}/*.el)) -LOGFILES = $(patsubst %.el,%.log,$(notdir ${ELFILES})) -TESTS = ${LOGFILES:.log=} +ELFILES = $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \ + -path "*resources" -prune -o -name "*el" -print) +## .elc files may be in a different directory for out of source builds +ELCFILES = $(patsubst %.el,%.elc, \ + $(patsubst $(srcdir)%,.%,$(ELFILES))) +LOGFILES = $(patsubst %.elc,%.log,${ELCFILES}) +LOGSAVEFILES = $(patsubst %.elc,%.log~,${ELCFILES}) +TESTS = $(subst ${srcdir}/,,$(LOGFILES:.log=)) ## If we have to interrupt a hanging test, preserve the log so we can ## see what the problem was. @@ -127,26 +139,46 @@ TESTS = ${LOGFILES:.log=} .PHONY: ${TESTS} ## The short aliases that always re-run the tests, with no logging. +## Define an alias both with and without the directory name for ease +## of use. define test_template $(1): - @test ! -f $(1).log || mv $(1).log $(1).log~ - @${MAKE} $(1).log WRITE_LOG= + @test ! -f ./$(1).log || mv ./$(1).log ./$(1).log~ + @${MAKE} ./$(1).log WRITE_LOG= + +$(notdir $(1)): $(1) endef $(foreach test,${TESTS},$(eval $(call test_template,${test}))) +## Check that there is no 'automated' subdirectory, which would +## indicate an incomplete merge from an older version of Emacs where +## the tests were arranged differently. +.PHONY: check-no-automated-subdir +check-no-automated-subdir: + test ! -d $(srcdir)/automated + +## Include dependencies between test files and the files they test. +## We could do this without the file and eval directly, but then we +## would have to run Emacs for every make invocation, and it might not +## be available during clean. +-include make-test-deps.mk ## Rerun all default tests. -check: mostlyclean +check: mostlyclean check-no-automated-subdir @${MAKE} check-doit SELECTOR="${SELECTOR_ACTUAL}" ## Rerun all default and expensive tests. .PHONY: check-expensive -check-expensive: mostlyclean +check-expensive: mostlyclean check-no-automated-subdir @${MAKE} check-doit SELECTOR="${SELECTOR_EXPENSIVE}" -## Only re-run default tests whose .log is older than the test. +## Re-run all tests which are outdated. A test is outdated if its +## logfile is out-of-date with either the test file, or the source +## files that the tests depend on. The source file dependencies are +## determined by a heuristic and does not identify the full dependency +## graph. See make-test-deps.emacs-lisp for details. .PHONY: check-maybe -check-maybe: +check-maybe: check-no-automated-subdir @${MAKE} check-doit SELECTOR="${SELECTOR_ACTUAL}" ## Run the tests. @@ -157,17 +189,25 @@ check-doit: ${LOGFILES} .PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean mostlyclean: - -@for f in *.log; do test ! -f $$f || mv $$f $$f~; done + -@for f in ${LOGFILES}; do test ! -f $$f || mv $$f $$f~; done + rm -f *.tmp clean: - -rm -f *.log *.log~ + -rm -f ${LOGFILES} ${LOGSAVEFILES} + -rm make-test-deps.mk bootstrap-clean: clean - -rm -f ${srcdir}/*.elc + -rm -f ${ELCFILES} distclean: clean rm -f Makefile maintainer-clean: distclean bootstrap-clean -# Makefile ends here. +make-test-deps.mk: $(ELFILES) make-test-deps.emacs-lisp + $(EMACS) --batch -l $(srcdir)/make-test-deps.emacs-lisp \ + --eval "(make-test-deps \"$(srcdir)\")" \ + 2> $@.tmp + # Hack to elide any CANNOT_DUMP=yes chatter. + sed '/\.log: /!d' $@.tmp >$@ + rm -f $@.tmp diff --git a/test/README b/test/README index d2aee9bf57b..fec84a8756c 100644 --- a/test/README +++ b/test/README @@ -4,12 +4,14 @@ See the end of the file for license conditions. This directory contains files intended to test various aspects of Emacs's functionality. Please help add tests! +See the file file-organization.org for the details of the directory +structure and file-naming conventions. + Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See (info "(ert)") or https://www.gnu.org/software/emacs/manual/html_node/ert/ for more information on writing and running tests. -All ERT test files are supposed to run from subdirectory automated/. -The Makefile in that directory supports the following targets: +The Makefile in this directory supports the following targets: * make check Run all tests as defined in the directory. Expensive tests are diff --git a/test/automated/abbrev-tests.el b/test/automated/abbrev-tests.el deleted file mode 100644 index 66413c5a590..00000000000 --- a/test/automated/abbrev-tests.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; abbrev-tests.el --- Test suite for abbrevs. - -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. - -;; Author: Eli Zaretskii <eliz@gnu.org> -;; Keywords: abbrevs - -;; 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; `kill-all-abbrevs-test' will remove all user *and* system abbrevs -;; if called noninteractively with the init file loaded. - -;;; Code: - -(require 'ert) -(require 'abbrev) -(require 'seq) - -;; set up test abbrev table and abbrev entry -(defun setup-test-abbrev-table () - (defvar ert-test-abbrevs nil) - (define-abbrev-table 'ert-test-abbrevs '(("a-e-t" "abbrev-ert-test"))) - (abbrev-table-put ert-test-abbrevs :ert-test "ert-test-value") - ert-test-abbrevs) - -(ert-deftest copy-abbrev-table-test () - (defvar foo-abbrev-table nil) ; Avoid compiler warning - (define-abbrev-table 'foo-abbrev-table - '()) - (should (abbrev-table-p foo-abbrev-table)) - ;; Bug 21828 - (let ((new-foo-abbrev-table - (condition-case nil - (copy-abbrev-table foo-abbrev-table) - (error nil)))) - (should (abbrev-table-p new-foo-abbrev-table))) - (should-not (string-equal (buffer-name) "*Backtrace*"))) - -(ert-deftest kill-all-abbrevs-test () - "Test undefining all defined abbrevs" - (unless noninteractive - (ert-skip "Cannot test kill-all-abbrevs in interactive mode")) - - (let ((num-tables 0)) - ;; ensure at least one abbrev exists - (should (abbrev-table-p (setup-test-abbrev-table))) - (setf num-tables (length abbrev-table-name-list)) - (kill-all-abbrevs) - - ;; no tables should have been removed/added - (should (= num-tables (length abbrev-table-name-list))) - ;; number of empty tables should be the same as number of tables - (should (= num-tables (length (seq-filter - (lambda (table) - (abbrev-table-empty-p (symbol-value table))) - abbrev-table-name-list)))))) - -(ert-deftest abbrev-table-name-test () - "Test returning name of abbrev-table" - (let ((ert-test-abbrevs (setup-test-abbrev-table)) - (no-such-table nil)) - (should (equal 'ert-test-abbrevs (abbrev-table-name ert-test-abbrevs))) - (should (equal nil (abbrev-table-name no-such-table))))) - -(ert-deftest clear-abbrev-table-test () - "Test clearing single abbrev table" - (let ((ert-test-abbrevs (setup-test-abbrev-table))) - (should (equal "a-e-t" (symbol-name - (abbrev-symbol "a-e-t" ert-test-abbrevs)))) - (should (equal "abbrev-ert-test" (symbol-value - (abbrev-symbol "a-e-t" ert-test-abbrevs)))) - - (clear-abbrev-table ert-test-abbrevs) - - (should (equal "nil" (symbol-name - (abbrev-symbol "a-e-t" ert-test-abbrevs)))) - (should (equal nil (symbol-value - (abbrev-symbol "a-e-t" ert-test-abbrevs)))) - (should (equal t (abbrev-table-empty-p ert-test-abbrevs))))) - -(provide 'abbrev-tests) - -;;; abbrev-tests.el ends here diff --git a/test/automated/coding-tests.el b/test/automated/coding-tests.el deleted file mode 100644 index cba8c7bc25f..00000000000 --- a/test/automated/coding-tests.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; coding-tests.el --- tests for text encoding and decoding - -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. - -;; Author: Eli Zaretskii <eliz@gnu.org> - -;; 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 <http://www.gnu.org/licenses/>. - -;;; Code: - -(require 'ert) - -;; Directory to hold test data files. -(defvar coding-tests-workdir - (expand-file-name "coding-tests" temporary-file-directory)) - -;; Remove all generated test files. -(defun coding-tests-remove-files () - (delete-directory coding-tests-workdir t)) - -(ert-deftest ert-test-coding-bogus-coding-systems () - (unwind-protect - (let (test-file) - (or (file-directory-p coding-tests-workdir) - (mkdir coding-tests-workdir t)) - (setq test-file (expand-file-name "nonexistent" coding-tests-workdir)) - (if (file-exists-p test-file) - (delete-file test-file)) - (should-error - (let ((coding-system-for-read 'bogus)) - (insert-file-contents test-file))) - ;; See bug #21602. - (setq test-file (expand-file-name "writing" coding-tests-workdir)) - (should-error - (let ((coding-system-for-write (intern "\"us-ascii\""))) - (write-region "some text" nil test-file)))) - (coding-tests-remove-files))) diff --git a/test/automated/core-elisp-tests.el b/test/automated/core-elisp-tests.el deleted file mode 100644 index b44bb37cc4f..00000000000 --- a/test/automated/core-elisp-tests.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; core-elisp-tests.el --- Testing some core Elisp rules - -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. - -;; Author: Stefan Monnier <monnier@iro.umontreal.ca> -;; Keywords: - -;; This program 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, -;; 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; - -;;; Code: - -(ert-deftest core-elisp-tests-1-defvar-in-let () - "Test some core Elisp rules." - (with-temp-buffer - ;; Check that when defvar is run within a let-binding, the toplevel default - ;; is properly initialized. - (should (equal (list (let ((c-e-x 1)) (defvar c-e-x 2) c-e-x) c-e-x) - '(1 2))) - (should (equal (list (let ((c-e-x 1)) - (defcustom c-e-x 2 "doc" :group 'blah :type 'integer) c-e-x) - c-e-x) - '(1 2))))) - -(ert-deftest core-elisp-tests-2-window-configurations () - "Test properties of window-configurations." - (let ((wc (current-window-configuration))) - (with-current-buffer (window-buffer (frame-selected-window)) - (push-mark) - (activate-mark)) - (set-window-configuration wc) - (should (or (not mark-active) (mark))))) - -(ert-deftest core-elisp-tests-3-backquote () - (should (eq 3 (eval ``,,'(+ 1 2))))) - -(provide 'core-elisp-tests) -;;; core-elisp-tests.el ends here diff --git a/test/automated/data-tests.el b/test/automated/data-tests.el deleted file mode 100644 index 0a292336f35..00000000000 --- a/test/automated/data-tests.el +++ /dev/null @@ -1,257 +0,0 @@ -;;; data-tests.el --- tests for src/data.c - -;; Copyright (C) 2013-2016 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(require 'cl-lib) -(eval-when-compile (require 'cl)) - -(ert-deftest data-tests-= () - (should-error (=)) - (should (= 1)) - (should (= 2 2)) - (should (= 9 9 9 9 9 9 9 9 9)) - (should-not (apply #'= '(3 8 3))) - (should-error (= 9 9 'foo)) - ;; Short circuits before getting to bad arg - (should-not (= 9 8 'foo))) - -(ert-deftest data-tests-< () - (should-error (<)) - (should (< 1)) - (should (< 2 3)) - (should (< -6 -1 0 2 3 4 8 9 999)) - (should-not (apply #'< '(3 8 3))) - (should-error (< 9 10 'foo)) - ;; Short circuits before getting to bad arg - (should-not (< 9 8 'foo))) - -(ert-deftest data-tests-> () - (should-error (>)) - (should (> 1)) - (should (> 3 2)) - (should (> 6 1 0 -2 -3 -4 -8 -9 -999)) - (should-not (apply #'> '(3 8 3))) - (should-error (> 9 8 'foo)) - ;; Short circuits before getting to bad arg - (should-not (> 8 9 'foo))) - -(ert-deftest data-tests-<= () - (should-error (<=)) - (should (<= 1)) - (should (<= 2 3)) - (should (<= -6 -1 -1 0 0 0 2 3 4 8 999)) - (should-not (apply #'<= '(3 8 3 3))) - (should-error (<= 9 10 'foo)) - ;; Short circuits before getting to bad arg - (should-not (<= 9 8 'foo))) - -(ert-deftest data-tests->= () - (should-error (>=)) - (should (>= 1)) - (should (>= 3 2)) - (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999)) - (should-not (apply #'>= '(3 8 3))) - (should-error (>= 9 8 'foo)) - ;; Short circuits before getting to bad arg - (should-not (>= 8 9 'foo))) - -;; Bool vector tests. Compactly represent bool vectors as hex -;; strings. - -(ert-deftest bool-vector-count-population-all-0-nil () - (cl-loop for sz in '(0 45 1 64 9 344) - do (let* ((bv (make-bool-vector sz nil))) - (should - (zerop - (bool-vector-count-population bv)))))) - -(ert-deftest bool-vector-count-population-all-1-t () - (cl-loop for sz in '(0 45 1 64 9 344) - do (let* ((bv (make-bool-vector sz t))) - (should - (eql - (bool-vector-count-population bv) - sz))))) - -(ert-deftest bool-vector-count-population-1-nil () - (let* ((bv (make-bool-vector 45 nil))) - (aset bv 40 t) - (aset bv 0 t) - (should - (eql - (bool-vector-count-population bv) - 2)))) - -(ert-deftest bool-vector-count-population-1-t () - (let* ((bv (make-bool-vector 45 t))) - (aset bv 40 nil) - (aset bv 0 nil) - (should - (eql - (bool-vector-count-population bv) - 43)))) - -(defun mock-bool-vector-count-consecutive (a b i) - (loop for i from i below (length a) - while (eq (aref a i) b) - sum 1)) - -(defun test-bool-vector-bv-from-hex-string (desc) - (let (bv nchars nibbles) - (dolist (c (string-to-list desc)) - (push (string-to-number - (char-to-string c) - 16) - nibbles)) - (setf bv (make-bool-vector (* 4 (length nibbles)) nil)) - (let ((i 0)) - (dolist (n (nreverse nibbles)) - (dotimes (_ 4) - (aset bv i (> (logand 1 n) 0)) - (incf i) - (setf n (lsh n -1))))) - bv)) - -(defun test-bool-vector-to-hex-string (bv) - (let (nibbles (v (cl-coerce bv 'list))) - (while v - (push (logior - (lsh (if (nth 0 v) 1 0) 0) - (lsh (if (nth 1 v) 1 0) 1) - (lsh (if (nth 2 v) 1 0) 2) - (lsh (if (nth 3 v) 1 0) 3)) - nibbles) - (setf v (nthcdr 4 v))) - (mapconcat (lambda (n) (format "%X" n)) - (nreverse nibbles) - ""))) - -(defun test-bool-vector-count-consecutive-tc (desc) - "Run a test case for bool-vector-count-consecutive. -DESC is a string describing the test. It is a sequence of -hexadecimal digits describing the bool vector. We exhaustively -test all counts at all possible positions in the vector by -comparing the subr with a much slower lisp implementation." - (let ((bv (test-bool-vector-bv-from-hex-string desc))) - (loop - for lf in '(nil t) - do (loop - for pos from 0 upto (length bv) - for cnt = (mock-bool-vector-count-consecutive bv lf pos) - for rcnt = (bool-vector-count-consecutive bv lf pos) - unless (eql cnt rcnt) - do (error "FAILED testcase %S %3S %3S %3S" - pos lf cnt rcnt))))) - -(defconst bool-vector-test-vectors -'("" - "0" - "F" - "0F" - "F0" - "00000000000000000000000000000FFFFF0000000" - "44a50234053fba3340000023444a50234053fba33400000234" - "12341234123456123412346001234123412345612341234600" - "44a50234053fba33400000234" - "1234123412345612341234600" - "44a50234053fba33400000234" - "1234123412345612341234600" - "44a502340" - "123412341" - "0000000000000000000000000" - "FFFFFFFFFFFFFFFF1")) - -(ert-deftest bool-vector-count-consecutive () - (mapc #'test-bool-vector-count-consecutive-tc - bool-vector-test-vectors)) - -(defun test-bool-vector-apply-mock-op (mock a b c) - "Compute (slowly) the correct result of a bool-vector set operation." - (let (changed nv) - (assert (eql (length b) (length c))) - (if a (setf nv a) - (setf a (make-bool-vector (length b) nil)) - (setf changed t)) - - (loop for i below (length b) - for mockr = (funcall mock - (if (aref b i) 1 0) - (if (aref c i) 1 0)) - for r = (not (= 0 mockr)) - do (progn - (unless (eq (aref a i) r) - (setf changed t)) - (setf (aref a i) r))) - (if changed a))) - -(defun test-bool-vector-binop (mock real) - "Test a binary set operation." - (loop for s1 in bool-vector-test-vectors - for bv1 = (test-bool-vector-bv-from-hex-string s1) - for vecs2 = (cl-remove-if-not - (lambda (x) (eql (length x) (length s1))) - bool-vector-test-vectors) - do (loop for s2 in vecs2 - for bv2 = (test-bool-vector-bv-from-hex-string s2) - for mock-result = (test-bool-vector-apply-mock-op - mock nil bv1 bv2) - for real-result = (funcall real bv1 bv2) - do (progn - (should (equal mock-result real-result)))))) - -(ert-deftest bool-vector-intersection-op () - (test-bool-vector-binop - #'logand - #'bool-vector-intersection)) - -(ert-deftest bool-vector-union-op () - (test-bool-vector-binop - #'logior - #'bool-vector-union)) - -(ert-deftest bool-vector-xor-op () - (test-bool-vector-binop - #'logxor - #'bool-vector-exclusive-or)) - -(ert-deftest bool-vector-set-difference-op () - (test-bool-vector-binop - (lambda (a b) (logand a (lognot b))) - #'bool-vector-set-difference)) - -(ert-deftest bool-vector-change-detection () - (let* ((vc1 (test-bool-vector-bv-from-hex-string "abcdef")) - (vc2 (test-bool-vector-bv-from-hex-string "012345")) - (vc3 (make-bool-vector (length vc1) nil)) - (c1 (bool-vector-union vc1 vc2 vc3)) - (c2 (bool-vector-union vc1 vc2 vc3))) - (should (equal c1 (test-bool-vector-apply-mock-op - #'logior - nil - vc1 vc2))) - (should (not c2)))) - -(ert-deftest bool-vector-not () - (let* ((v1 (test-bool-vector-bv-from-hex-string "FFFF3")) - (v2 (test-bool-vector-bv-from-hex-string "0000C")) - (v3 (bool-vector-not v1))) - (should (equal v2 v3)))) diff --git a/test/automated/help-fns.el b/test/automated/help-fns.el deleted file mode 100644 index babba1a68fc..00000000000 --- a/test/automated/help-fns.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; help-fns.el --- tests for help-fns.el - -;; Copyright (C) 2014-2016 Free Software Foundation, Inc. - -;; Maintainer: emacs-devel@gnu.org - -;; 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(require 'ert) - -(autoload 'help-fns-test--macro "help-fns" nil nil t) - -(ert-deftest help-fns-test-bug17410 () - "Test for http://debbugs.gnu.org/17410 ." - (describe-function 'help-fns-test--macro) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "autoloaded Lisp macro" (line-end-position))))) - -(defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x) - "A function with a funny name. - -\(fn XYZZY)" - x) - -(defun defgh\\\[universal-argument\]b\`c\'d\\e\"f (x) - "Another function with a funny name." - x) - -(ert-deftest help-fns-test-funny-names () - "Test for help with functions with funny names." - (describe-function 'abc\\\[universal-argument\]b\`c\'d\\e\"f) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward - "(abc\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f XYZZY)"))) - (describe-function 'defgh\\\[universal-argument\]b\`c\'d\\e\"f) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward - "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)")))) - -(ert-deftest help-fns-test-describe-symbol () - "Test the `describe-symbol' function." - ;; 'describe-symbol' would originally signal an error for - ;; 'font-lock-comment-face'. - (describe-symbol 'font-lock-comment-face) - (with-current-buffer "*Help*" - (should (> (point-max) 1)) - (goto-char (point-min)) - (should (looking-at "^font-lock-comment-face is ")))) - -;;; help-fns.el ends here diff --git a/test/automated/lexbind-tests.el b/test/automated/lexbind-tests.el deleted file mode 100644 index 3bf8c1361ad..00000000000 --- a/test/automated/lexbind-tests.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; lexbind-tests.el --- Testing the lexbind byte-compiler - -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. - -;; Author: Stefan Monnier <monnier@iro.umontreal.ca> -;; Keywords: - -;; This program 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, -;; 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; - -;;; Code: - -(require 'ert) - -(defconst lexbind-tests - `( - (let ((f #'car)) - (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) - (funcall f '(1 . 2)))) - ) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") - - - -(defun lexbind-check-1 (pat) - "Return non-nil if PAT is the same whether directly evalled or compiled." - (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case nil - (eval pat t) - (error nil))) - (v1 (condition-case nil - (funcall (let ((lexical-binding t)) - (byte-compile `(lambda nil ,pat)))) - (error nil)))) - (equal v0 v1))) - -(put 'lexbind-check-1 'ert-explainer 'lexbind-explain-1) - -(defun lexbind-explain-1 (pat) - (let ((v0 (condition-case nil - (eval pat t) - (error nil))) - (v1 (condition-case nil - (funcall (let ((lexical-binding t)) - (byte-compile (list 'lambda nil pat)))) - (error nil)))) - (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." - pat v0 v1))) - -(ert-deftest lexbind-tests () - "Test the Emacs byte compiler lexbind handling." - (dolist (pat lexbind-tests) - (should (lexbind-check-1 pat)))) - - - -(provide 'lexbind-tests) -;;; lexbind-tests.el ends here diff --git a/test/automated/syntax-tests.el b/test/automated/syntax-tests.el deleted file mode 100644 index d4af80e8ebe..00000000000 --- a/test/automated/syntax-tests.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; syntax-tests.el --- Testing syntax rules and basic movement -*- lexical-binding: t -*- - -;; Copyright (C) 2014-2016 Free Software Foundation, Inc. - -;; Author: Daniel Colascione <dancol@dancol.org> -;; Keywords: - -;; This program 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, -;; 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 <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; - -;;; Code: -(require 'ert) -(require 'cl-lib) - -(defun run-up-list-test (fn data start instructions) - (cl-labels ((posof (thing) - (and (symbolp thing) - (= (length (symbol-name thing)) 1) - (- (aref (symbol-name thing) 0) ?a -1)))) - (with-temp-buffer - (set-syntax-table (make-syntax-table)) - ;; Use a syntax table in which single quote is a string - ;; character so that we can embed the test data in a lisp string - ;; literal. - (modify-syntax-entry ?\' "\"") - (insert data) - (goto-char (posof start)) - (dolist (instruction instructions) - (cond ((posof instruction) - (funcall fn) - (should (eql (point) (posof instruction)))) - ((symbolp instruction) - (should-error (funcall fn) - :type instruction)) - (t (cl-assert nil nil "unknown ins"))))))) - -(defmacro define-up-list-test (name fn data start &rest expected) - `(ert-deftest ,name () - (run-up-list-test ,fn ,data ',start ',expected))) - -(define-up-list-test up-list-basic - (lambda () (up-list)) - (or "(1 1 (1 1) 1 (1 1) 1)") - ;; abcdefghijklmnopqrstuv - i k v scan-error) - -(define-up-list-test up-list-with-forward-sexp-function - (lambda () - (let ((forward-sexp-function - (lambda (&optional arg) - (let ((forward-sexp-function nil)) - (forward-sexp arg))))) - (up-list))) - (or "(1 1 (1 1) 1 (1 1) 1)") - ;; abcdefghijklmnopqrstuv - i k v scan-error) - -(define-up-list-test up-list-out-of-string - (lambda () (up-list 1 t)) - (or "1 (1 '2 2 (2 2 2' 1) 1") - ;; abcdefghijklmnopqrstuvwxy - o r u scan-error) - -(define-up-list-test up-list-cross-string - (lambda () (up-list 1 t)) - (or "(1 '2 ( 2' 1 '2 ) 2' 1)") - ;; abcdefghijklmnopqrstuvwxy - i r u x scan-error) - -(define-up-list-test up-list-no-cross-string - (lambda () (up-list 1 t t)) - (or "(1 '2 ( 2' 1 '2 ) 2' 1)") - ;; abcdefghijklmnopqrstuvwxy - i k x scan-error) - -(define-up-list-test backward-up-list-basic - (lambda () (backward-up-list)) - (or "(1 1 (1 1) 1 (1 1) 1)") - ;; abcdefghijklmnopqrstuv - i f a scan-error) - -(provide 'syntax-tests) -;;; syntax-tests.el ends here diff --git a/test/automated/tramp-tests.el b/test/automated/tramp-tests.el deleted file mode 100644 index 34d8d6ad495..00000000000 --- a/test/automated/tramp-tests.el +++ /dev/null @@ -1,2383 +0,0 @@ -;;; tramp-tests.el --- Tests of remote file access - -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. - -;; Author: Michael Albinus <michael.albinus@gmx.de> - -;; This program 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, 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 `http://www.gnu.org/licenses/'. - -;;; Commentary: - -;; The tests require a recent ert.el from Emacs 24.4. - -;; Some of the tests require access to a remote host files. Since -;; this could be problematic, a mock-up connection method "mock" is -;; used. Emulating a remote connection, it simply calls "sh -i". -;; Tramp's file name handlers still run, so this test is sufficient -;; except for connection establishing. - -;; If you want to test a real Tramp connection, set -;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to -;; overwrite the default value. If you want to skip tests accessing a -;; remote host, set this environment variable to "/dev/null" or -;; whatever is appropriate on your system. - -;; A whole test run can be performed calling the command `tramp-test-all'. - -;;; Code: - -(require 'ert) -(require 'tramp) -(require 'vc) -(require 'vc-bzr) -(require 'vc-git) -(require 'vc-hg) - -(autoload 'dired-uncache "dired") -(declare-function tramp-find-executable "tramp-sh") -(declare-function tramp-get-remote-path "tramp-sh") -(declare-function tramp-get-remote-stat "tramp-sh") -(declare-function tramp-get-remote-perl "tramp-sh") -(defvar tramp-copy-size-limit) -(defvar tramp-persistency-file-name) -(defvar tramp-remote-process-environment) - -;; There is no default value on w32 systems, which could work out of the box. -(defconst tramp-test-temporary-file-directory - (cond - ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) - ((eq system-type 'windows-nt) null-device) - (t (add-to-list - 'tramp-methods - '("mock" - (tramp-login-program "sh") - (tramp-login-args (("-i"))) - (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")) - (tramp-connection-timeout 10))) - (format "/mock::%s" temporary-file-directory))) - "Temporary directory for Tramp tests.") - -(setq password-cache-expiry nil - tramp-verbose 0 - tramp-copy-size-limit nil - tramp-message-show-message nil - tramp-persistency-file-name nil) - -;; This shall happen on hydra only. -(when (getenv "NIX_STORE") - (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) - -(defvar tramp--test-enabled-checked nil - "Cached result of `tramp--test-enabled'. -If the function did run, the value is a cons cell, the `cdr' -being the result.") - -(defun tramp--test-enabled () - "Whether remote file access is enabled." - (unless (consp tramp--test-enabled-checked) - (setq - tramp--test-enabled-checked - (cons - t (ignore-errors - (and - (file-remote-p tramp-test-temporary-file-directory) - (file-directory-p tramp-test-temporary-file-directory) - (file-writable-p tramp-test-temporary-file-directory)))))) - - (when (cdr tramp--test-enabled-checked) - ;; Cleanup connection. - (ignore-errors - (tramp-cleanup-connection - (tramp-dissect-file-name tramp-test-temporary-file-directory) - nil 'keep-password))) - - ;; Return result. - (cdr tramp--test-enabled-checked)) - -(defun tramp--test-make-temp-name (&optional local) - "Create a temporary file name for test." - (expand-file-name - (make-temp-name "tramp-test") - (if local temporary-file-directory tramp-test-temporary-file-directory))) - -(defmacro tramp--instrument-test-case (verbose &rest body) - "Run BODY with `tramp-verbose' equal VERBOSE. -Print the the content of the Tramp debug buffer, if BODY does not -eval properly in `should', `should-not' or `should-error'. BODY -shall not contain a timeout." - (declare (indent 1) (debug (natnump body))) - `(let ((tramp-verbose ,verbose) - (tramp-message-show-message t) - (tramp-debug-on-error t) - (debug-ignored-errors - (cons "^make-symbolic-link not supported$" debug-ignored-errors))) - (unwind-protect - (progn ,@body) - (when (> tramp-verbose 3) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (with-current-buffer (tramp-get-connection-buffer v) - (message "%s" (buffer-string))) - (with-current-buffer (tramp-get-debug-buffer v) - (message "%s" (buffer-string)))))))) - -(ert-deftest tramp-test00-availability () - "Test availability of Tramp functions." - :expected-result (if (tramp--test-enabled) :passed :failed) - (message "Remote directory: `%s'" tramp-test-temporary-file-directory) - (should (ignore-errors - (and - (file-remote-p tramp-test-temporary-file-directory) - (file-directory-p tramp-test-temporary-file-directory) - (file-writable-p tramp-test-temporary-file-directory))))) - -(ert-deftest tramp-test01-file-name-syntax () - "Check remote file name syntax." - ;; Simple cases. - (should (tramp-tramp-file-p "/method::")) - (should (tramp-tramp-file-p "/host:")) - (should (tramp-tramp-file-p "/user@:")) - (should (tramp-tramp-file-p "/user@host:")) - (should (tramp-tramp-file-p "/method:host:")) - (should (tramp-tramp-file-p "/method:user@:")) - (should (tramp-tramp-file-p "/method:user@host:")) - (should (tramp-tramp-file-p "/method:user@email@host:")) - - ;; Using a port. - (should (tramp-tramp-file-p "/host#1234:")) - (should (tramp-tramp-file-p "/user@host#1234:")) - (should (tramp-tramp-file-p "/method:host#1234:")) - (should (tramp-tramp-file-p "/method:user@host#1234:")) - - ;; Using an IPv4 address. - (should (tramp-tramp-file-p "/1.2.3.4:")) - (should (tramp-tramp-file-p "/user@1.2.3.4:")) - (should (tramp-tramp-file-p "/method:1.2.3.4:")) - (should (tramp-tramp-file-p "/method:user@1.2.3.4:")) - - ;; Using an IPv6 address. - (should (tramp-tramp-file-p "/[]:")) - (should (tramp-tramp-file-p "/[::1]:")) - (should (tramp-tramp-file-p "/user@[::1]:")) - (should (tramp-tramp-file-p "/method:[::1]:")) - (should (tramp-tramp-file-p "/method:user@[::1]:")) - - ;; Local file name part. - (should (tramp-tramp-file-p "/host:/:")) - (should (tramp-tramp-file-p "/method:::")) - (should (tramp-tramp-file-p "/method::/path/to/file")) - (should (tramp-tramp-file-p "/method::file")) - - ;; Multihop. - (should (tramp-tramp-file-p "/method1:|method2::")) - (should (tramp-tramp-file-p "/method1:host1|host2:")) - (should (tramp-tramp-file-p "/method1:host1|method2:host2:")) - (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:")) - (should (tramp-tramp-file-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:")) - - ;; No strings. - (should-not (tramp-tramp-file-p nil)) - (should-not (tramp-tramp-file-p 'symbol)) - ;; "/:" suppresses file name handlers. - (should-not (tramp-tramp-file-p "/::")) - (should-not (tramp-tramp-file-p "/:@:")) - (should-not (tramp-tramp-file-p "/:[]:")) - ;; Multihops require a method. - (should-not (tramp-tramp-file-p "/host1|host2:")) - ;; Methods or hostnames shall be at least two characters on MS Windows. - (when (memq system-type '(cygwin windows-nt)) - (should-not (tramp-tramp-file-p "/c:/path/to/file")) - (should-not (tramp-tramp-file-p "/c::/path/to/file")))) - -(ert-deftest tramp-test02-file-name-dissect () - "Check remote file name components." - (let ((tramp-default-method "default-method") - (tramp-default-user "default-user") - (tramp-default-host "default-host")) - ;; Expand `tramp-default-user' and `tramp-default-host'. - (should (string-equal - (file-remote-p "/method::") - (format "/%s:%s@%s:" "method" "default-user" "default-host"))) - (should (string-equal (file-remote-p "/method::" 'method) "method")) - (should (string-equal (file-remote-p "/method::" 'user) "default-user")) - (should (string-equal (file-remote-p "/method::" 'host) "default-host")) - (should (string-equal (file-remote-p "/method::" 'localname) "")) - (should (string-equal (file-remote-p "/method::" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (should (string-equal - (file-remote-p "/host:") - (format "/%s:%s@%s:" "default-method" "default-user" "host"))) - (should (string-equal (file-remote-p "/host:" 'method) "default-method")) - (should (string-equal (file-remote-p "/host:" 'user) "default-user")) - (should (string-equal (file-remote-p "/host:" 'host) "host")) - (should (string-equal (file-remote-p "/host:" 'localname) "")) - (should (string-equal (file-remote-p "/host:" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-host'. - (should (string-equal - (file-remote-p "/user@:") - (format "/%s:%s@%s:" "default-method""user" "default-host"))) - (should (string-equal (file-remote-p "/user@:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@:" 'user) "user")) - (should (string-equal (file-remote-p "/user@:" 'host) "default-host")) - (should (string-equal (file-remote-p "/user@:" 'localname) "")) - (should (string-equal (file-remote-p "/user@:" 'hop) nil)) - - ;; Expand `tramp-default-method'. - (should (string-equal - (file-remote-p "/user@host:") - (format "/%s:%s@%s:" "default-method" "user" "host"))) - (should (string-equal - (file-remote-p "/user@host:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@host:" 'user) "user")) - (should (string-equal (file-remote-p "/user@host:" 'host) "host")) - (should (string-equal (file-remote-p "/user@host:" 'localname) "")) - (should (string-equal (file-remote-p "/user@host:" 'hop) nil)) - - ;; Expand `tramp-default-user'. - (should (string-equal - (file-remote-p "/method:host:") - (format "/%s:%s@%s:" "method" "default-user" "host"))) - (should (string-equal (file-remote-p "/method:host:" 'method) "method")) - (should (string-equal (file-remote-p "/method:host:" 'user) "default-user")) - (should (string-equal (file-remote-p "/method:host:" 'host) "host")) - (should (string-equal (file-remote-p "/method:host:" 'localname) "")) - (should (string-equal (file-remote-p "/method:host:" 'hop) nil)) - - ;; Expand `tramp-default-host'. - (should (string-equal - (file-remote-p "/method:user@:") - (format "/%s:%s@%s:" "method" "user" "default-host"))) - (should (string-equal (file-remote-p "/method:user@:" 'method) "method")) - (should (string-equal (file-remote-p "/method:user@:" 'user) "user")) - (should (string-equal (file-remote-p "/method:user@:" 'host) - "default-host")) - (should (string-equal (file-remote-p "/method:user@:" 'localname) "")) - (should (string-equal (file-remote-p "/method:user@:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@host:") - (format "/%s:%s@%s:" "method" "user" "host"))) - (should (string-equal - (file-remote-p "/method:user@host:" 'method) "method")) - (should (string-equal (file-remote-p "/method:user@host:" 'user) "user")) - (should (string-equal (file-remote-p "/method:user@host:" 'host) "host")) - (should (string-equal (file-remote-p "/method:user@host:" 'localname) "")) - (should (string-equal (file-remote-p "/method:user@host:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@email@host:") - (format "/%s:%s@%s:" "method" "user@email" "host"))) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'user) "user@email")) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'host) "host")) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'localname) "")) - (should (string-equal - (file-remote-p "/method:user@email@host:" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (should (string-equal - (file-remote-p "/host#1234:") - (format "/%s:%s@%s:" "default-method" "default-user" "host#1234"))) - (should (string-equal - (file-remote-p "/host#1234:" 'method) "default-method")) - (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user")) - (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234")) - (should (string-equal (file-remote-p "/host#1234:" 'localname) "")) - (should (string-equal (file-remote-p "/host#1234:" 'hop) nil)) - - ;; Expand `tramp-default-method'. - (should (string-equal - (file-remote-p "/user@host#1234:") - (format "/%s:%s@%s:" "default-method" "user" "host#1234"))) - (should (string-equal - (file-remote-p "/user@host#1234:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user")) - (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234")) - (should (string-equal (file-remote-p "/user@host#1234:" 'localname) "")) - (should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil)) - - ;; Expand `tramp-default-user'. - (should (string-equal - (file-remote-p "/method:host#1234:") - (format "/%s:%s@%s:" "method" "default-user" "host#1234"))) - (should (string-equal - (file-remote-p "/method:host#1234:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:host#1234:" 'user) "default-user")) - (should (string-equal - (file-remote-p "/method:host#1234:" 'host) "host#1234")) - (should (string-equal (file-remote-p "/method:host#1234:" 'localname) "")) - (should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@host#1234:") - (format "/%s:%s@%s:" "method" "user" "host#1234"))) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'user) "user")) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'host) "host#1234")) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'localname) "")) - (should (string-equal - (file-remote-p "/method:user@host#1234:" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (should (string-equal - (file-remote-p "/1.2.3.4:") - (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4"))) - (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method")) - (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user")) - (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4")) - (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) "")) - (should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil)) - - ;; Expand `tramp-default-method'. - (should (string-equal - (file-remote-p "/user@1.2.3.4:") - (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4"))) - (should (string-equal - (file-remote-p "/user@1.2.3.4:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user")) - (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4")) - (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) "")) - (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil)) - - ;; Expand `tramp-default-user'. - (should (string-equal - (file-remote-p "/method:1.2.3.4:") - (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4"))) - (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:1.2.3.4:" 'user) "default-user")) - (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4")) - (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) "")) - (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:") - (format "/%s:%s@%s:" "method" "user" "1.2.3.4"))) - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:" 'method) "method")) - (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user")) - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4")) - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:" 'localname) "")) - (should (string-equal - (file-remote-p "/method:user@1.2.3.4:" 'hop) nil)) - - ;; Expand `tramp-default-method', `tramp-default-user' and - ;; `tramp-default-host'. - (should (string-equal - (file-remote-p "/[]:") - (format - "/%s:%s@%s:" "default-method" "default-user" "default-host"))) - (should (string-equal (file-remote-p "/[]:" 'method) "default-method")) - (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) - (should (string-equal (file-remote-p "/[]:" 'host) "default-host")) - (should (string-equal (file-remote-p "/[]:" 'localname) "")) - (should (string-equal (file-remote-p "/[]:" 'hop) nil)) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (let ((tramp-default-host "::1")) - (should (string-equal - (file-remote-p "/[]:") - (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) - (should (string-equal (file-remote-p "/[]:" 'method) "default-method")) - (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) - (should (string-equal (file-remote-p "/[]:" 'host) "::1")) - (should (string-equal (file-remote-p "/[]:" 'localname) "")) - (should (string-equal (file-remote-p "/[]:" 'hop) nil))) - - ;; Expand `tramp-default-method' and `tramp-default-user'. - (should (string-equal - (file-remote-p "/[::1]:") - (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) - (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method")) - (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user")) - (should (string-equal (file-remote-p "/[::1]:" 'host) "::1")) - (should (string-equal (file-remote-p "/[::1]:" 'localname) "")) - (should (string-equal (file-remote-p "/[::1]:" 'hop) nil)) - - ;; Expand `tramp-default-method'. - (should (string-equal - (file-remote-p "/user@[::1]:") - (format "/%s:%s@%s:" "default-method" "user" "[::1]"))) - (should (string-equal - (file-remote-p "/user@[::1]:" 'method) "default-method")) - (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user")) - (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1")) - (should (string-equal (file-remote-p "/user@[::1]:" 'localname) "")) - (should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil)) - - ;; Expand `tramp-default-user'. - (should (string-equal - (file-remote-p "/method:[::1]:") - (format "/%s:%s@%s:" "method" "default-user" "[::1]"))) - (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method")) - (should (string-equal - (file-remote-p "/method:[::1]:" 'user) "default-user")) - (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1")) - (should (string-equal (file-remote-p "/method:[::1]:" 'localname) "")) - (should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil)) - - ;; No expansion. - (should (string-equal - (file-remote-p "/method:user@[::1]:") - (format "/%s:%s@%s:" "method" "user" "[::1]"))) - (should (string-equal - (file-remote-p "/method:user@[::1]:" 'method) "method")) - (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user")) - (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1")) - (should (string-equal - (file-remote-p "/method:user@[::1]:" 'localname) "")) - (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil)) - - ;; Local file name part. - (should (string-equal (file-remote-p "/host:/:" 'localname) "/:")) - (should (string-equal (file-remote-p "/method:::" 'localname) ":")) - (should (string-equal (file-remote-p "/method:: " 'localname) " ")) - (should (string-equal (file-remote-p "/method::file" 'localname) "file")) - (should (string-equal - (file-remote-p "/method::/path/to/file" 'localname) - "/path/to/file")) - - ;; Multihop. - (should - (string-equal - (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file") - (format "/%s:%s@%s|%s:%s@%s:" - "method1" "user1" "host1" "method2" "user2" "host2"))) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) - "method2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) - "user2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) - "host2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop) - (format "%s:%s@%s|" - "method1" "user1" "host1"))) - - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file") - (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" - "method1" "user1" "host1" - "method2" "user2" "host2" - "method3" "user3" "host3"))) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'method) - "method3")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'user) - "user3")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'host) - "host3")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2|method3:user3@host3:/path/to/file" - 'hop) - (format "%s:%s@%s|%s:%s@%s|" - "method1" "user1" "host1" "method2" "user2" "host2"))))) - -(ert-deftest tramp-test03-file-name-defaults () - "Check default values for some methods." - ;; Default values in tramp-adb.el. - (should (string-equal (file-remote-p "/adb::" 'host) "")) - ;; Default values in tramp-ftp.el. - (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp")) - (dolist (u '("ftp" "anonymous")) - (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp"))) - ;; Default values in tramp-gvfs.el. - (when (and (load "tramp-gvfs" 'noerror 'nomessage) - (symbol-value 'tramp-gvfs-enabled)) - (should (string-equal (file-remote-p "/synce::" 'user) nil))) - ;; Default values in tramp-gw.el. - (dolist (m '("tunnel" "socks")) - (should - (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) - ;; Default values in tramp-sh.el. - (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) - (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su"))) - (dolist (m '("su" "sudo" "ksu")) - (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))) - (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp")) - (should - (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) - ;; Default values in tramp-smb.el. - (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb")) - (should (string-equal (file-remote-p "/smb::" 'user) nil))) - -(ert-deftest tramp-test04-substitute-in-file-name () - "Check `substitute-in-file-name'." - (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo")) - (should - (string-equal - (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo")) - (should - (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo")) - (should - (string-equal - (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo")) - (should - (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo")) - (let (process-environment) - (should - (string-equal - (substitute-in-file-name "/method:host:/path/$FOO") - "/method:host:/path/$FOO")) - (setenv "FOO" "bla") - (should - (string-equal - (substitute-in-file-name "/method:host:/path/$FOO") - "/method:host:/path/bla")) - (should - (string-equal - (substitute-in-file-name "/method:host:/path/$$FOO") - "/method:host:/path/$FOO")))) - -(ert-deftest tramp-test05-expand-file-name () - "Check `expand-file-name'." - (should - (string-equal - (expand-file-name "/method:host:/path/./file") "/method:host:/path/file")) - (should - (string-equal - (expand-file-name "/method:host:/path/../file") "/method:host:/file"))) - -(ert-deftest tramp-test06-directory-file-name () - "Check `directory-file-name'. -This checks also `file-name-as-directory', `file-name-directory', -`file-name-nondirectory' and `unhandled-file-name-directory'." - (should - (string-equal - (directory-file-name "/method:host:/path/to/file") - "/method:host:/path/to/file")) - (should - (string-equal - (directory-file-name "/method:host:/path/to/file/") - "/method:host:/path/to/file")) - (should - (string-equal - (file-name-as-directory "/method:host:/path/to/file") - "/method:host:/path/to/file/")) - (should - (string-equal - (file-name-as-directory "/method:host:/path/to/file/") - "/method:host:/path/to/file/")) - (should - (string-equal - (file-name-directory "/method:host:/path/to/file") - "/method:host:/path/to/")) - (should - (string-equal - (file-name-directory "/method:host:/path/to/file/") - "/method:host:/path/to/file/")) - (should - (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file")) - (should - (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) - (should-not - (unhandled-file-name-directory "/method:host:/path/to/file"))) - -(ert-deftest tramp-test07-file-exists-p () - "Check `file-exist-p', `write-region' and `delete-file'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (should-not (file-exists-p tmp-name)) - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (delete-file tmp-name) - (should-not (file-exists-p tmp-name)))) - -(ert-deftest tramp-test08-file-local-copy () - "Check `file-local-copy'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - tmp-name2) - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (setq tmp-name2 (file-local-copy tmp-name1))) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - ;; Check also that a file transfer with compression works. - (let ((default-directory tramp-test-temporary-file-directory) - (tramp-copy-size-limit 4) - (tramp-inline-compress-start-size 2)) - (delete-file tmp-name2) - (should (setq tmp-name2 (file-local-copy tmp-name1))))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))))) - -(ert-deftest tramp-test09-insert-file-contents () - "Check `insert-file-contents'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo")) - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foofoo")) - ;; Insert partly. - (insert-file-contents tmp-name nil 1 3) - (should (string-equal (buffer-string) "oofoofoo")) - ;; Replace. - (insert-file-contents tmp-name nil nil nil 'replace) - (should (string-equal (buffer-string) "foo")))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test10-write-region () - "Check `write-region'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (with-temp-buffer - (insert "foo") - (write-region nil nil tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo"))) - ;; Append. - (with-temp-buffer - (insert "bla") - (write-region nil nil tmp-name 'append)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foobla"))) - ;; Write string. - (write-region "foo" nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo"))) - ;; Write partly. - (with-temp-buffer - (insert "123456789") - (write-region 3 5 tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "34")))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test11-copy-file () - "Check `copy-file'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name)) - (tmp-name4 (tramp--test-make-temp-name 'local)) - (tmp-name5 (tramp--test-make-temp-name 'local))) - - ;; Copy on remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (copy-file tmp-name1 tmp-name2) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name1 tmp-name2)) - (copy-file tmp-name1 tmp-name2 'ok) - (make-directory tmp-name3) - (copy-file tmp-name1 tmp-name3) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2)) - (ignore-errors (delete-directory tmp-name3 'recursive))) - - ;; Copy from remote side to local side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (copy-file tmp-name1 tmp-name4) - (should (file-exists-p tmp-name4)) - (with-temp-buffer - (insert-file-contents tmp-name4) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name1 tmp-name4)) - (copy-file tmp-name1 tmp-name4 'ok) - (make-directory tmp-name5) - (copy-file tmp-name1 tmp-name5) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name5 'recursive))) - - ;; Copy from local side to remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name4 nil 'nomessage) - (copy-file tmp-name4 tmp-name1) - (should (file-exists-p tmp-name1)) - (with-temp-buffer - (insert-file-contents tmp-name1) - (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name4 tmp-name1)) - (copy-file tmp-name4 tmp-name1 'ok) - (make-directory tmp-name3) - (copy-file tmp-name4 tmp-name3) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name3 'recursive))))) - -(ert-deftest tramp-test12-rename-file () - "Check `rename-file'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name)) - (tmp-name4 (tramp--test-make-temp-name 'local)) - (tmp-name5 (tramp--test-make-temp-name 'local))) - - ;; Rename on remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (rename-file tmp-name1 tmp-name2) - (should-not (file-exists-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-file-contents tmp-name2) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name1) - (should-error (rename-file tmp-name1 tmp-name2)) - (rename-file tmp-name1 tmp-name2 'ok) - (should-not (file-exists-p tmp-name1)) - (write-region "foo" nil tmp-name1) - (make-directory tmp-name3) - (rename-file tmp-name1 tmp-name3) - (should-not (file-exists-p tmp-name1)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2)) - (ignore-errors (delete-directory tmp-name3 'recursive))) - - ;; Rename from remote side to local side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (rename-file tmp-name1 tmp-name4) - (should-not (file-exists-p tmp-name1)) - (should (file-exists-p tmp-name4)) - (with-temp-buffer - (insert-file-contents tmp-name4) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name1) - (should-error (rename-file tmp-name1 tmp-name4)) - (rename-file tmp-name1 tmp-name4 'ok) - (should-not (file-exists-p tmp-name1)) - (write-region "foo" nil tmp-name1) - (make-directory tmp-name5) - (rename-file tmp-name1 tmp-name5) - (should-not (file-exists-p tmp-name1)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name5 'recursive))) - - ;; Rename from local side to remote side. - (unwind-protect - (progn - (write-region "foo" nil tmp-name4 nil 'nomessage) - (rename-file tmp-name4 tmp-name1) - (should-not (file-exists-p tmp-name4)) - (should (file-exists-p tmp-name1)) - (with-temp-buffer - (insert-file-contents tmp-name1) - (should (string-equal (buffer-string) "foo"))) - (write-region "foo" nil tmp-name4 nil 'nomessage) - (should-error (rename-file tmp-name4 tmp-name1)) - (rename-file tmp-name4 tmp-name1 'ok) - (should-not (file-exists-p tmp-name4)) - (write-region "foo" nil tmp-name4 nil 'nomessage) - (make-directory tmp-name3) - (rename-file tmp-name4 tmp-name3) - (should-not (file-exists-p tmp-name4)) - (should - (file-exists-p - (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name4)) - (ignore-errors (delete-directory tmp-name3 'recursive))))) - -(ert-deftest tramp-test13-make-directory () - "Check `make-directory'. -This tests also `file-directory-p' and `file-accessible-directory-p'." - (skip-unless (tramp--test-enabled)) - - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo/bar" tmp-name1))) - (unwind-protect - (progn - (make-directory tmp-name1) - (should (file-directory-p tmp-name1)) - (should (file-accessible-directory-p tmp-name1)) - (should-error (make-directory tmp-name2) :type 'file-error) - (make-directory tmp-name2 'parents) - (should (file-directory-p tmp-name2)) - (should (file-accessible-directory-p tmp-name2))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test14-delete-directory () - "Check `delete-directory'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - ;; Delete empty directory. - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (delete-directory tmp-name) - (should-not (file-directory-p tmp-name)) - ;; Delete non-empty directory. - (make-directory tmp-name) - (write-region "foo" nil (expand-file-name "bla" tmp-name)) - (should-error (delete-directory tmp-name) :type 'file-error) - (delete-directory tmp-name 'recursive) - (should-not (file-directory-p tmp-name)))) - -(ert-deftest tramp-test15-copy-directory () - "Check `copy-directory'." - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-smb-file-name-handler))) - - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (expand-file-name - (file-name-nondirectory tmp-name1) tmp-name2)) - (tmp-name4 (expand-file-name "foo" tmp-name1)) - (tmp-name5 (expand-file-name "foo" tmp-name2)) - (tmp-name6 (expand-file-name "foo" tmp-name3))) - (unwind-protect - (progn - ;; Copy empty directory. - (make-directory tmp-name1) - (write-region "foo" nil tmp-name4) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name4)) - (copy-directory tmp-name1 tmp-name2) - (should (file-directory-p tmp-name2)) - (should (file-exists-p tmp-name5)) - ;; Target directory does exist already. - (copy-directory tmp-name1 tmp-name2) - (should (file-directory-p tmp-name3)) - (should (file-exists-p tmp-name6))) - - ;; Cleanup. - (ignore-errors - (delete-directory tmp-name1 'recursive) - (delete-directory tmp-name2 'recursive))))) - -(ert-deftest tramp-test16-directory-files () - "Check `directory-files'." - (skip-unless (tramp--test-enabled)) - - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "bla" tmp-name1)) - (tmp-name3 (expand-file-name "foo" tmp-name1))) - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (write-region "bla" nil tmp-name3) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (should (file-exists-p tmp-name3)) - (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo"))) - (should (equal (directory-files tmp-name1 'full) - `(,(concat tmp-name1 "/.") - ,(concat tmp-name1 "/..") - ,tmp-name2 ,tmp-name3))) - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - '("bla" "foo"))) - (should (equal (directory-files - tmp-name1 'full directory-files-no-dot-files-regexp) - `(,tmp-name2 ,tmp-name3)))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test17-insert-directory () - "Check `insert-directory'." - (skip-unless (tramp--test-enabled)) - - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo" tmp-name1)) - ;; We test for the summary line. Keyword "total" could be localized. - (process-environment - (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment))) - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (with-temp-buffer - (insert-directory tmp-name1 nil) - (goto-char (point-min)) - (should (looking-at-p (regexp-quote tmp-name1)))) - (with-temp-buffer - (insert-directory tmp-name1 "-al") - (goto-char (point-min)) - (should (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) - (with-temp-buffer - (insert-directory (file-name-as-directory tmp-name1) "-al") - (goto-char (point-min)) - (should - (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) - (with-temp-buffer - (insert-directory - (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) - (goto-char (point-min)) - (should - (looking-at-p - (concat - ;; There might be a summary line. - "\\(total.+[[:digit:]]+\n\\)?" - ;; We don't know in which order ".", ".." and "foo" appear. - "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}"))))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test18-file-attributes () - "Check `file-attributes'. -This tests also `file-readable-p' and `file-regular-p'." - (skip-unless (tramp--test-enabled)) - - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - ;; File name with "//". - (tmp-name3 - (format - "%s%s" - (file-remote-p tmp-name1) - (replace-regexp-in-string - "/" "//" (file-remote-p tmp-name1 'localname)))) - attr) - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (setq attr (file-attributes tmp-name1)) - (should (consp attr)) - (should (file-exists-p tmp-name1)) - (should (file-readable-p tmp-name1)) - (should (file-regular-p tmp-name1)) - ;; We do not test inodes and device numbers. - (should (null (car attr))) - (should (numberp (nth 1 attr))) ;; Link. - (should (numberp (nth 2 attr))) ;; Uid. - (should (numberp (nth 3 attr))) ;; Gid. - ;; Last access time. - (should (stringp (current-time-string (nth 4 attr)))) - ;; Last modification time. - (should (stringp (current-time-string (nth 5 attr)))) - ;; Last status change time. - (should (stringp (current-time-string (nth 6 attr)))) - (should (numberp (nth 7 attr))) ;; Size. - (should (stringp (nth 8 attr))) ;; Modes. - - (setq attr (file-attributes tmp-name1 'string)) - (should (stringp (nth 2 attr))) ;; Uid. - (should (stringp (nth 3 attr))) ;; Gid. - - (condition-case err - (progn - (make-symbolic-link tmp-name1 tmp-name2) - (should (file-exists-p tmp-name2)) - (should (file-symlink-p tmp-name2)) - (setq attr (file-attributes tmp-name2)) - (should (string-equal - (car attr) - (file-remote-p (file-truename tmp-name1) 'localname))) - (delete-file tmp-name2)) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))) - - ;; Check, that "//" in symlinks are handled properly. - (with-temp-buffer - (let ((default-directory tramp-test-temporary-file-directory)) - (shell-command - (format - "ln -s %s %s" - (tramp-file-name-localname (tramp-dissect-file-name tmp-name3)) - (tramp-file-name-localname (tramp-dissect-file-name tmp-name2))) - t))) - (when (file-symlink-p tmp-name2) - (setq attr (file-attributes tmp-name2)) - (should - (string-equal - (car attr) - (tramp-file-name-localname (tramp-dissect-file-name tmp-name3)))) - (delete-file tmp-name2)) - - (delete-file tmp-name1) - (make-directory tmp-name1) - (should (file-exists-p tmp-name1)) - (should (file-readable-p tmp-name1)) - (should-not (file-regular-p tmp-name1)) - (setq attr (file-attributes tmp-name1)) - (should (eq (car attr) t))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1)) - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-file tmp-name2))))) - -(ert-deftest tramp-test19-directory-files-and-attributes () - "Check `directory-files-and-attributes'." - (skip-unless (tramp--test-enabled)) - - ;; `directory-files-and-attributes' contains also values for "../". - ;; Ensure that this doesn't change during tests, for - ;; example due to handling temporary files. - (let* ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "bla" tmp-name1)) - attr) - (unwind-protect - (progn - (make-directory tmp-name1) - (should (file-directory-p tmp-name1)) - (make-directory tmp-name2) - (should (file-directory-p tmp-name2)) - (write-region "foo" nil (expand-file-name "foo" tmp-name2)) - (write-region "bar" nil (expand-file-name "bar" tmp-name2)) - (write-region "boz" nil (expand-file-name "boz" tmp-name2)) - (setq attr (directory-files-and-attributes tmp-name2)) - (should (consp attr)) - ;; Dumb remote shells without perl(1) or stat(1) are not - ;; able to return the date correctly. They say "don't know". - (dolist (elt attr) - (unless - (equal - (nth 5 - (file-attributes (expand-file-name (car elt) tmp-name2))) - '(0 0)) - (should - (equal (file-attributes (expand-file-name (car elt) tmp-name2)) - (cdr elt))))) - (setq attr (directory-files-and-attributes tmp-name2 'full)) - (dolist (elt attr) - (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) - (should - (equal (file-attributes (car elt)) (cdr elt))))) - (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) - (should (equal (mapcar 'car attr) '("bar" "boz")))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test20-file-modes () - "Check `file-modes'. -This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-adb-file-name-handler - tramp-gvfs-file-name-handler - tramp-smb-file-name-handler)))) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (set-file-modes tmp-name #o777) - (should (= (file-modes tmp-name) #o777)) - (should (file-executable-p tmp-name)) - (should (file-writable-p tmp-name)) - (set-file-modes tmp-name #o444) - (should (= (file-modes tmp-name) #o444)) - (should-not (file-executable-p tmp-name)) - ;; A file is always writable for user "root". - (unless (zerop (nth 2 (file-attributes tmp-name))) - (should-not (file-writable-p tmp-name)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test21-file-links () - "Check `file-symlink-p'. -This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." - (skip-unless (tramp--test-enabled)) - - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name 'local))) - - ;; Check `make-symbolic-link'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - ;; Method "smb" supports `make-symbolic-link' only if the - ;; remote host has CIFS capabilities. tramp-adb.el and - ;; tramp-gvfs.el do not support symbolic links at all. - (condition-case err - (make-symbolic-link tmp-name1 tmp-name2) - (file-error - (skip-unless - (not (string-equal (error-message-string err) - "make-symbolic-link not supported"))))) - (should (file-symlink-p tmp-name2)) - (should-error (make-symbolic-link tmp-name1 tmp-name2)) - (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) - (should (file-symlink-p tmp-name2)) - ;; `tmp-name3' is a local file name. - (should-error (make-symbolic-link tmp-name1 tmp-name3))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; Check `add-name-to-file'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (add-name-to-file tmp-name1 tmp-name2) - (should-not (file-symlink-p tmp-name2)) - (should-error (add-name-to-file tmp-name1 tmp-name2)) - (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) - (should-not (file-symlink-p tmp-name2)) - ;; `tmp-name3' is a local file name. - (should-error (add-name-to-file tmp-name1 tmp-name3))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; Check `file-truename'. - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (make-symbolic-link tmp-name1 tmp-name2) - (should (file-symlink-p tmp-name2)) - (should-not (string-equal tmp-name2 (file-truename tmp-name2))) - (should - (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) - (should (file-equal-p tmp-name1 tmp-name2))) - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))) - - ;; `file-truename' shall preserve trailing link of directories. - (unless (file-symlink-p tramp-test-temporary-file-directory) - (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) - (dir2 (file-name-as-directory dir1))) - (should (string-equal (file-truename dir1) (expand-file-name dir1))) - (should (string-equal (file-truename dir2) (expand-file-name dir2))))))) - -(ert-deftest tramp-test22-file-times () - "Check `set-file-times' and `file-newer-than-file-p'." - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler)))) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name)) - (tmp-name3 (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name1) - (should (file-exists-p tmp-name1)) - (should (consp (nth 5 (file-attributes tmp-name1)))) - ;; '(0 0) means don't know, and will be replaced by - ;; `current-time'. Therefore, we use '(0 1). - ;; We skip the test, if the remote handler is not able to - ;; set the correct time. - (skip-unless (set-file-times tmp-name1 '(0 1))) - ;; Dumb remote shells without perl(1) or stat(1) are not - ;; able to return the date correctly. They say "don't know". - (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) - (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) - (write-region "bla" nil tmp-name2) - (should (file-exists-p tmp-name2)) - (should (file-newer-than-file-p tmp-name2 tmp-name1)) - ;; `tmp-name3' does not exist. - (should (file-newer-than-file-p tmp-name2 tmp-name3)) - (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))) - - ;; Cleanup. - (ignore-errors - (delete-file tmp-name1) - (delete-file tmp-name2))))) - -(ert-deftest tramp-test23-visited-file-modtime () - "Check `set-visited-file-modtime' and `verify-visited-file-modtime'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (verify-visited-file-modtime)) - (set-visited-file-modtime '(0 1)) - (should (verify-visited-file-modtime)) - (should (equal (visited-file-modtime) '(0 1 0 0))))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test24-file-name-completion () - "Check `file-name-completion' and `file-name-all-completions'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (make-directory tmp-name) - (should (file-directory-p tmp-name)) - (write-region "foo" nil (expand-file-name "foo" tmp-name)) - (write-region "bar" nil (expand-file-name "bold" tmp-name)) - (make-directory (expand-file-name "boz" tmp-name)) - (should (equal (file-name-completion "fo" tmp-name) "foo")) - (should (equal (file-name-completion "b" tmp-name) "bo")) - (should - (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) - (should (equal (file-name-all-completions "fo" tmp-name) '("foo"))) - (should - (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp) - '("bold" "boz/")))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name 'recursive))))) - -(ert-deftest tramp-test25-load () - "Check `load'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name (tramp--test-make-temp-name))) - (unwind-protect - (progn - (load tmp-name 'noerror 'nomessage) - (should-not (featurep 'tramp-test-load)) - (write-region "(provide 'tramp-test-load)" nil tmp-name) - ;; `load' in lread.c does not pass `must-suffix'. Why? - ;(should-error (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)) - (load tmp-name nil 'nomessage 'nosuffix) - (should (featurep 'tramp-test-load))) - - ;; Cleanup. - (ignore-errors - (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load)) - (delete-file tmp-name))))) - -(ert-deftest tramp-test26-process-file () - "Check `process-file'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-gvfs-file-name-handler tramp-smb-file-name-handler)))) - - (let* ((tmp-name (tramp--test-make-temp-name)) - (fnnd (file-name-nondirectory tmp-name)) - (default-directory tramp-test-temporary-file-directory) - kill-buffer-query-functions) - (unwind-protect - (progn - ;; We cannot use "/bin/true" and "/bin/false"; those paths - ;; do not exist on hydra. - (should (zerop (process-file "true"))) - (should-not (zerop (process-file "false"))) - (should-not (zerop (process-file "binary-does-not-exist"))) - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (should (zerop (process-file "ls" nil t nil fnnd))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should (string-equal (format "%s\n" fnnd) (buffer-string))) - (should-not (get-buffer-window (current-buffer) t)) - - ;; Second run. The output must be appended. - (goto-char (point-max)) - (should (zerop (process-file "ls" nil t t fnnd))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) - ;; A non-nil DISPLAY must not raise the buffer. - (should-not (get-buffer-window (current-buffer) t)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(ert-deftest tramp-test27-start-file-process () - "Check `start-file-process'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-adb-file-name-handler - tramp-gvfs-file-name-handler - tramp-smb-file-name-handler)))) - - (let ((default-directory tramp-test-temporary-file-directory) - (tmp-name (tramp--test-make-temp-name)) - kill-buffer-query-functions proc) - (unwind-protect - (with-temp-buffer - (setq proc (start-file-process "test1" (current-buffer) "cat")) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors (delete-process proc))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (setq proc - (start-file-process - "test2" (current-buffer) - "cat" (file-name-nondirectory tmp-name))) - (should (processp proc)) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors - (delete-process proc) - (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (setq proc (start-file-process "test3" (current-buffer) "cat")) - (should (processp proc)) - (should (equal (process-status proc) 'run)) - (set-process-filter - proc - (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) - (process-send-string proc "foo") - (process-send-eof proc) - ;; Read output. - (with-timeout (10 (ert-fail "`start-file-process' timed out")) - (while (< (- (point-max) (point-min)) (length "foo")) - (accept-process-output proc 1))) - (should (string-equal (buffer-string) "foo"))) - - ;; Cleanup. - (ignore-errors (delete-process proc))))) - -(ert-deftest tramp-test28-shell-command () - "Check `shell-command'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (not - (memq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - '(tramp-adb-file-name-handler - tramp-gvfs-file-name-handler - tramp-smb-file-name-handler)))) - - (let ((tmp-name (tramp--test-make-temp-name)) - (default-directory tramp-test-temporary-file-directory) - kill-buffer-query-functions) - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) - (set-process-sentinel (get-buffer-process (current-buffer)) nil) - ;; Read output. - (with-timeout (10 (ert-fail "`async-shell-command' timed out")) - (while (< (- (point-max) (point-min)) - (1+ (length (file-name-nondirectory tmp-name)))) - (accept-process-output (get-buffer-process (current-buffer)) 1))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - ;; There might be a nasty "Process *Async Shell* finished" message. - (goto-char (point-min)) - (forward-line) - (narrow-to-region (point-min) (point)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command "read line; ls $line" (current-buffer)) - (set-process-sentinel (get-buffer-process (current-buffer)) nil) - (process-send-string - (get-buffer-process (current-buffer)) - (format "%s\n" (file-name-nondirectory tmp-name))) - ;; Read output. - (with-timeout (10 (ert-fail "`async-shell-command' timed out")) - (while (< (- (point-max) (point-min)) - (1+ (length (file-name-nondirectory tmp-name)))) - (accept-process-output (get-buffer-process (current-buffer)) 1))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while (re-search-forward tramp-color-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - ;; There might be a nasty "Process *Async Shell* finished" message. - (goto-char (point-min)) - (forward-line) - (narrow-to-region (point-min) (point)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))))) - -(defun tramp-test--shell-command-to-string-asynchronously (command) - "Like `shell-command-to-string', but for asynchronous processes." - (with-temp-buffer - (async-shell-command command (current-buffer)) - ;; Suppress nasty messages. - (set-process-sentinel (get-buffer-process (current-buffer)) nil) - (while (get-buffer-process (current-buffer)) - (accept-process-output (get-buffer-process (current-buffer)) 0.1)) - (accept-process-output) - (buffer-substring-no-properties (point-min) (point-max)))) - -;; This test is inspired by Bug#23952. -(ert-deftest tramp-test29-environment-variables () - "Check that remote processes set / unset environment variables properly." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - (dolist (this-shell-command-to-string - '(;; Synchronously. - shell-command-to-string - ;; Asynchronously. - tramp-test--shell-command-to-string-asynchronously)) - - (let ((default-directory tramp-test-temporary-file-directory) - (shell-file-name "/bin/sh") - (envvar (concat "VAR_" (upcase (md5 (current-time-string))))) - kill-buffer-query-functions) - - (unwind-protect - ;; Set a value. - (let ((process-environment - (cons (concat envvar "=foo") process-environment))) - ;; Default value. - (should - (string-match - "foo" - (funcall - this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))))) - - (unwind-protect - ;; Set the empty value. - (let ((process-environment - (cons (concat envvar "=") process-environment))) - ;; Value is null. - (should - (string-match - "bla" - (funcall - this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) - ;; Variable is set. - (should - (string-match - (regexp-quote envvar) - (funcall this-shell-command-to-string "set"))))) - - ;; We force a reconnect, in order to have a clean environment. - (tramp-cleanup-connection - (tramp-dissect-file-name tramp-test-temporary-file-directory) - 'keep-debug 'keep-password) - (unwind-protect - ;; Unset the variable. - (let ((tramp-remote-process-environment - (cons (concat envvar "=foo") - tramp-remote-process-environment))) - ;; Set the initial value, we want to unset below. - (should - (string-match - "foo" - (funcall - this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) - (let ((process-environment - (cons envvar process-environment))) - ;; Variable is unset. - (should - (string-match - "bla" - (funcall - this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) - ;; Variable is unset. - (should-not - (string-match - (regexp-quote envvar) - (funcall this-shell-command-to-string "set"))))))))) - -(ert-deftest tramp-test30-vc-registered () - "Check `vc-registered'." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - (let* ((default-directory tramp-test-temporary-file-directory) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (expand-file-name "foo" tmp-name1)) - (tramp-remote-process-environment tramp-remote-process-environment) - (vc-handled-backends - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (cond - ((tramp-find-executable v vc-git-program (tramp-get-remote-path v)) - '(Git)) - ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v)) - '(Hg)) - ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v)) - (setq tramp-remote-process-environment - (cons (format "BZR_HOME=%s" - (file-remote-p tmp-name1 'localname)) - tramp-remote-process-environment)) - ;; We must force a reconnect, in order to activate $BZR_HOME. - (tramp-cleanup-connection - (tramp-dissect-file-name tramp-test-temporary-file-directory) - nil 'keep-password) - '(Bzr)) - (t nil))))) - (skip-unless vc-handled-backends) - (message "%s" vc-handled-backends) - - (unwind-protect - (progn - (make-directory tmp-name1) - (write-region "foo" nil tmp-name2) - (should (file-directory-p tmp-name1)) - (should (file-exists-p tmp-name2)) - (should-not (vc-registered tmp-name1)) - (should-not (vc-registered tmp-name2)) - - (let ((default-directory tmp-name1)) - ;; Create empty repository, and register the file. - ;; Sometimes, creation of repository fails (bzr!); we skip - ;; the test then. - (condition-case nil - (vc-create-repo (car vc-handled-backends)) - (error (skip-unless nil))) - ;; The structure of VC-FILESET is not documented. Let's - ;; hope it won't change. - (condition-case nil - (vc-register - (list (car vc-handled-backends) - (list (file-name-nondirectory tmp-name2)))) - ;; `vc-register' has changed its arguments in Emacs 25.1. - (error - (vc-register - nil (list (car vc-handled-backends) - (list (file-name-nondirectory tmp-name2)))))) - ;; vc-git uses an own process sentinel, Tramp's sentinel - ;; for flushing the cache isn't used. - (dired-uncache (concat (file-remote-p default-directory) "/")) - (should (vc-registered (file-name-nondirectory tmp-name2))))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive))))) - -(ert-deftest tramp-test31-make-auto-save-file-name () - "Check `make-auto-save-file-name'." - (skip-unless (tramp--test-enabled)) - - (let ((tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name))) - - (unwind-protect - (progn - ;; Use default `auto-save-file-name-transforms' mechanism. - (let (tramp-auto-save-directory) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from original `make-auto-save-file-name'. - (expand-file-name - (format - "#%s#" - (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) - temporary-file-directory))))) - - ;; No mapping. - (let (tramp-auto-save-directory auto-save-file-name-transforms) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - (expand-file-name - (format "#%s#" (file-name-nondirectory tmp-name1)) - tramp-test-temporary-file-directory))))) - - ;; Use default `tramp-auto-save-directory' mechanism. - (let ((tramp-auto-save-directory tmp-name2)) - (with-temp-buffer - (setq buffer-file-name tmp-name1) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from Tramp. - (expand-file-name - (format - "#%s#" - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - tmp-name1)) - tmp-name2))) - (should (file-directory-p tmp-name2)))) - - ;; Relative file names shall work, too. - (let ((tramp-auto-save-directory ".")) - (with-temp-buffer - (setq buffer-file-name tmp-name1 - default-directory tmp-name2) - (should - (string-equal - (make-auto-save-file-name) - ;; This is taken from Tramp. - (expand-file-name - (format - "#%s#" - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - tmp-name1)) - tmp-name2))) - (should (file-directory-p tmp-name2))))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name1)) - (ignore-errors (delete-directory tmp-name2 'recursive))))) - -(defun tramp--test-adb-p () - "Check, whether the remote host runs Android. -This requires restrictions of file name syntax." - (tramp-adb-file-name-p tramp-test-temporary-file-directory)) - -(defun tramp--test-ftp-p () - "Check, whether an FTP-like method is used. -This does not support globbing characters in file names (yet)." - ;; Globbing characters are ??, ?* and ?\[. - (and (eq (tramp-find-foreign-file-name-handler - tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler) - (string-match - "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))) - -(defun tramp--test-gvfs-p () - "Check, whether the remote host runs a GVFS based method. -This requires restrictions of file name syntax." - (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)) - -(defun tramp--test-smb-or-windows-nt-p () - "Check, whether the locale or remote host runs MS Windows. -This requires restrictions of file name syntax." - (or (eq system-type 'windows-nt) - (tramp-smb-file-name-p tramp-test-temporary-file-directory))) - -(defun tramp--test-hpux-p () - "Check, whether the remote host runs HP-UX. -Several special characters do not work properly there." - ;; We must refill the cache. `file-truename' does it. - (with-parsed-tramp-file-name - (file-truename tramp-test-temporary-file-directory) nil - (string-match "^HP-UX" (tramp-get-connection-property v "uname" "")))) - -(defun tramp--test-check-files (&rest files) - "Run a simple but comprehensive test over every file in FILES." - ;; We must use `file-truename' for the temporary directory, because - ;; it could be located on a symlinked directory. This would let the - ;; test fail. - (let* ((tramp-test-temporary-file-directory - (file-truename tramp-test-temporary-file-directory)) - (tmp-name1 (tramp--test-make-temp-name)) - (tmp-name2 (tramp--test-make-temp-name 'local)) - (files (delq nil files))) - (unwind-protect - (progn - (make-directory tmp-name1) - (make-directory tmp-name2) - (dolist (elt files) - (let* ((file1 (expand-file-name elt tmp-name1)) - (file2 (expand-file-name elt tmp-name2)) - (file3 (expand-file-name (concat elt "foo") tmp-name1))) - (write-region elt nil file1) - (should (file-exists-p file1)) - - ;; Check file contents. - (with-temp-buffer - (insert-file-contents file1) - (should (string-equal (buffer-string) elt))) - - ;; Copy file both directions. - (copy-file file1 tmp-name2) - (should (file-exists-p file2)) - (delete-file file1) - (should-not (file-exists-p file1)) - (copy-file file2 tmp-name1) - (should (file-exists-p file1)) - - ;; Method "smb" supports `make-symbolic-link' only if the - ;; remote host has CIFS capabilities. tramp-adb.el and - ;; tramp-gvfs.el do not support symbolic links at all. - (condition-case err - (progn - (make-symbolic-link file1 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (expand-file-name file1) (file-truename file3))) - (should - (string-equal - (car (file-attributes file3)) - (file-remote-p (file-truename file1) 'localname))) - ;; Check file contents. - (with-temp-buffer - (insert-file-contents file3) - (should (string-equal (buffer-string) elt))) - (delete-file file3)) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))))) - - ;; Check file names. - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - (sort (copy-sequence files) 'string-lessp))) - (should (equal (directory-files - tmp-name2 nil directory-files-no-dot-files-regexp) - (sort (copy-sequence files) 'string-lessp))) - - ;; `substitute-in-file-name' could return different values. - ;; For `adb', there could be strange file permissions - ;; preventing overwriting a file. We don't care in this - ;; testcase. - (dolist (elt files) - (let ((file1 - (substitute-in-file-name (expand-file-name elt tmp-name1))) - (file2 - (substitute-in-file-name (expand-file-name elt tmp-name2)))) - (ignore-errors (write-region elt nil file1)) - (should (file-exists-p file1)) - (ignore-errors (write-region elt nil file2 nil 'nomessage)) - (should (file-exists-p file2)))) - - (should (equal (directory-files - tmp-name1 nil directory-files-no-dot-files-regexp) - (directory-files - tmp-name2 nil directory-files-no-dot-files-regexp))) - - ;; Check directory creation. We use a subdirectory "foo" - ;; in order to avoid conflicts with previous file name tests. - (dolist (elt files) - (let* ((elt1 (concat elt "foo")) - (file1 (expand-file-name (concat "foo/" elt) tmp-name1)) - (file2 (expand-file-name elt file1)) - (file3 (expand-file-name elt1 file1))) - (make-directory file1 'parents) - (should (file-directory-p file1)) - (write-region elt nil file2) - (should (file-exists-p file2)) - (should - (equal - (directory-files file1 nil directory-files-no-dot-files-regexp) - `(,elt))) - (should - (equal - (caar (directory-files-and-attributes - file1 nil directory-files-no-dot-files-regexp)) - elt)) - - ;; Check symlink in `directory-files-and-attributes'. - (condition-case err - (progn - (make-symbolic-link file2 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (caar (directory-files-and-attributes - file1 nil (regexp-quote elt1))) - elt1)) - (should - (string-equal - (cadr (car (directory-files-and-attributes - file1 nil (regexp-quote elt1)))) - (file-remote-p (file-truename file2) 'localname))) - (delete-file file3) - (should-not (file-exists-p file3))) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))) - - (delete-file file2) - (should-not (file-exists-p file2)) - (delete-directory file1) - (should-not (file-exists-p file1))))) - - ;; Cleanup. - (ignore-errors (delete-directory tmp-name1 'recursive)) - (ignore-errors (delete-directory tmp-name2 'recursive))))) - -(defun tramp--test-special-characters () - "Perform the test in `tramp-test32-special-characters*'." - ;; Newlines, slashes and backslashes in file names are not - ;; supported. So we don't test. And we don't test the tab - ;; character on Windows or Cygwin, because the backslash is - ;; interpreted as a path separator, preventing "\t" from being - ;; expanded to <TAB>. - (tramp--test-check-files - (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - "foo bar baz" - (if (or (tramp--test-adb-p) (eq system-type 'cygwin)) - " foo bar baz " - " foo\tbar baz\t")) - "$foo$bar$$baz$" - "-foo-bar-baz-" - "%foo%bar%baz%" - "&foo&bar&baz&" - (unless (or (tramp--test-ftp-p) - (tramp--test-gvfs-p) - (tramp--test-smb-or-windows-nt-p)) - "?foo?bar?baz?") - (unless (or (tramp--test-ftp-p) - (tramp--test-gvfs-p) - (tramp--test-smb-or-windows-nt-p)) - "*foo*bar*baz*") - (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - "'foo'bar'baz'" - "'foo\"bar'baz\"") - "#foo~bar#baz~" - (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - "!foo!bar!baz!" - "!foo|bar!baz|") - (if (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - ";foo;bar;baz;" - ":foo;bar:baz;") - (unless (or (tramp--test-gvfs-p) (tramp--test-smb-or-windows-nt-p)) - "<foo>bar<baz>") - "(foo)bar(baz)" - (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") - "{foo}bar{baz}")) - -;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test32-special-characters () - "Check special characters in file names." - (skip-unless (tramp--test-enabled)) - - (tramp--test-special-characters)) - -(ert-deftest tramp-test32-special-characters-with-stat () - "Check special characters in file names. -Use the `stat' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (skip-unless (tramp-get-remote-stat v))) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "perl" nil)) - tramp-connection-properties))) - (tramp--test-special-characters))) - -(ert-deftest tramp-test32-special-characters-with-perl () - "Check special characters in file names. -Use the `perl' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (skip-unless (tramp-get-remote-perl v))) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "readlink" nil)) - tramp-connection-properties))) - (tramp--test-special-characters))) - -(ert-deftest tramp-test32-special-characters-with-ls () - "Check special characters in file names. -Use the `ls' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "perl" nil) - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "readlink" nil)) - tramp-connection-properties))) - (tramp--test-special-characters))) - -(defun tramp--test-utf8 () - "Perform the test in `tramp-test33-utf8*'." - (let* ((utf8 (if (and (eq system-type 'darwin) - (memq 'utf-8-hfs (coding-system-list))) - 'utf-8-hfs 'utf-8)) - (coding-system-for-read utf8) - (coding-system-for-write utf8) - (file-name-coding-system utf8)) - (tramp--test-check-files - (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") - (unless (tramp--test-hpux-p) - "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") - "银河系漫游指南系列" - "Автостопом по гала́ктике"))) - -(ert-deftest tramp-test33-utf8 () - "Check UTF8 encoding in file names and file contents." - (skip-unless (tramp--test-enabled)) - - (tramp--test-utf8)) - -(ert-deftest tramp-test33-utf8-with-stat () - "Check UTF8 encoding in file names and file contents. -Use the `stat' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (skip-unless (tramp-get-remote-stat v))) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "perl" nil)) - tramp-connection-properties))) - (tramp--test-utf8))) - -(ert-deftest tramp-test33-utf8-with-perl () - "Check UTF8 encoding in file names and file contents. -Use the `perl' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil - (skip-unless (tramp-get-remote-perl v))) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "readlink" nil)) - tramp-connection-properties))) - (tramp--test-utf8))) - -(ert-deftest tramp-test33-utf8-with-ls () - "Check UTF8 encoding in file names and file contents. -Use the `ls' command." - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - (let ((tramp-connection-properties - (append - `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "perl" nil) - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "stat" nil) - ;; See `tramp-sh-handle-file-truename'. - (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) - "readlink" nil)) - tramp-connection-properties))) - (tramp--test-utf8))) - -;; This test is inspired by Bug#16928. -(ert-deftest tramp-test34-asynchronous-requests () - "Check parallel asynchronous requests. -Such requests could arrive from timers, process filters and -process sentinels. They shall not disturb each other." - ;; Mark as failed until bug has been fixed. - :expected-result :failed - :tags '(:expensive-test) - (skip-unless (tramp--test-enabled)) - (skip-unless - (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) - 'tramp-sh-file-name-handler)) - - ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. This - ;; has the side effect, that this test fails instead to abort. Good - ;; for hydra. - (tramp--instrument-test-case 0 - (let* ((tmp-name (tramp--test-make-temp-name)) - (default-directory tmp-name) - (remote-file-name-inhibit-cache t) - timer buffers kill-buffer-query-functions) - - (unwind-protect - (progn - (make-directory tmp-name) - - ;; Setup a timer in order to raise an ordinary command again - ;; and again. `vc-registered' is well suited, because there - ;; are many checks. - (setq - timer - (run-at-time - 0 1 - (lambda () - (when buffers - (vc-registered - (buffer-name (nth (random (length buffers)) buffers))))))) - - ;; Create temporary buffers. The number of buffers - ;; corresponds to the number of processes; it could be - ;; increased in order to make pressure on Tramp. - (dotimes (i 5) - (add-to-list 'buffers (generate-new-buffer "*temp*"))) - - ;; Open asynchronous processes. Set process sentinel. - (dolist (buf buffers) - (async-shell-command "read line; touch $line; echo $line" buf) - (set-process-sentinel - (get-buffer-process buf) - (lambda (proc _state) - (delete-file (buffer-name (process-buffer proc)))))) - - ;; Send a string. Use a random order of the buffers. Mix - ;; with regular operation. - (let ((buffers (copy-sequence buffers)) - buf) - (while buffers - (setq buf (nth (random (length buffers)) buffers)) - (process-send-string - (get-buffer-process buf) (format "'%s'\n" buf)) - (file-attributes (buffer-name buf)) - (setq buffers (delq buf buffers)))) - - ;; Wait until the whole output has been read. - (with-timeout ((* 10 (length buffers)) - (ert-fail "`async-shell-command' timed out")) - (let ((buffers (copy-sequence buffers)) - buf) - (while buffers - (setq buf (nth (random (length buffers)) buffers)) - (if (ignore-errors - (memq (process-status (get-buffer-process buf)) - '(run open))) - (accept-process-output (get-buffer-process buf) 0.1) - (setq buffers (delq buf buffers)))))) - - ;; Check. - (dolist (buf buffers) - (with-current-buffer buf - (should - (string-equal (format "'%s'\n" buf) (buffer-string))))) - (should-not - (directory-files tmp-name nil directory-files-no-dot-files-regexp))) - - ;; Cleanup. - (ignore-errors (cancel-timer timer)) - (ignore-errors (delete-directory tmp-name 'recursive)) - (dolist (buf buffers) - (ignore-errors (kill-buffer buf))))))) - -(ert-deftest tramp-test35-recursive-load () - "Check that Tramp does not fail due to recursive load." - (skip-unless (tramp--test-enabled)) - - (dolist (code - (list - (format - "(expand-file-name %S)" - tramp-test-temporary-file-directory) - (format - "(let ((default-directory %S)) (expand-file-name %S))" - tramp-test-temporary-file-directory - temporary-file-directory))) - (should-not - (string-match - "Recursive load" - (shell-command-to-string - (format - "%s -batch -Q -L %s --eval %s" - (expand-file-name invocation-name invocation-directory) - (mapconcat 'shell-quote-argument load-path " -L ") - (shell-quote-argument code))))))) - -(ert-deftest tramp-test36-unload () - "Check that Tramp and its subpackages unload completely. -Since it unloads Tramp, it shall be the last test to run." - ;; Mark as failed until all symbols are unbound. - :expected-result (if (featurep 'tramp) :failed :passed) - :tags '(:expensive-test) - (when (featurep 'tramp) - (unload-feature 'tramp 'force) - ;; No Tramp feature must be left. - (should-not (featurep 'tramp)) - (should-not (all-completions "tramp" (delq 'tramp-tests features))) - ;; `file-name-handler-alist' must be clean. - (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) - ;; There shouldn't be left a bound symbol. We do not regard our - ;; test symbols, and the Tramp unload hooks. - (mapatoms - (lambda (x) - (and (or (boundp x) (functionp x)) - (string-match "^tramp" (symbol-name x)) - (not (string-match "^tramp--?test" (symbol-name x))) - (not (string-match "unload-hook$" (symbol-name x))) - (ert-fail (format "`%s' still bound" x))))) - ;; There shouldn't be left a hook function containing a Tramp - ;; function. We do not regard the Tramp unload hooks. - (mapatoms - (lambda (x) - (and (boundp x) - (string-match "-hooks?$" (symbol-name x)) - (not (string-match "unload-hook$" (symbol-name x))) - (consp (symbol-value x)) - (ignore-errors (all-completions "tramp" (symbol-value x))) - (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) - -;; TODO: - -;; * dired-compress-file -;; * dired-uncache -;; * file-acl -;; * file-ownership-preserved-p -;; * file-selinux-context -;; * find-backup-file-name -;; * set-file-acl -;; * set-file-selinux-context - -;; * Work on skipped tests. Make a comment, when it is impossible. -;; * Fix `tramp-test15-copy-directory' for `smb'. Using tar in a pipe -;; doesn't work well when an interactive password must be provided. -;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). -;; * Fix Bug#16928. Set expected error of `tramp-test34-asynchronous-requests'. -;; * Fix `tramp-test36-unload' (Not all symbols are unbound). Set -;; expected error. - -(defun tramp-test-all (&optional interactive) - "Run all tests for \\[tramp]." - (interactive "p") - (funcall - (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp")) - -(provide 'tramp-tests) -;;; tramp-tests.el ends here diff --git a/test/automated/data/decompress/foo.gz b/test/data/decompress/foo.gz Binary files differindex a68653fcbb9..a68653fcbb9 100644 --- a/test/automated/data/decompress/foo.gz +++ b/test/data/decompress/foo.gz diff --git a/test/automated/data/epg/pubkey.asc b/test/data/epg/pubkey.asc index c0bf28f6200..c0bf28f6200 100644 --- a/test/automated/data/epg/pubkey.asc +++ b/test/data/epg/pubkey.asc diff --git a/test/automated/data/epg/seckey.asc b/test/data/epg/seckey.asc index 4ac7ba4a502..4ac7ba4a502 100644 --- a/test/automated/data/epg/seckey.asc +++ b/test/data/epg/seckey.asc diff --git a/test/automated/data/files-bug18141.el.gz b/test/data/files-bug18141.el.gz Binary files differindex 53d463e85b5..53d463e85b5 100644 --- a/test/automated/data/files-bug18141.el.gz +++ b/test/data/files-bug18141.el.gz diff --git a/test/data/net/cert.pem b/test/data/net/cert.pem new file mode 100644 index 00000000000..4df4e92e0bf --- /dev/null +++ b/test/data/net/cert.pem @@ -0,0 +1,25 @@ +-----BEGIN CERTIFICATE----- +MIIELTCCAxWgAwIBAgIJAI6LqlFyaPRkMA0GCSqGSIb3DQEBCwUAMIGsMQswCQYD +VQQGEwJBVTEYMBYGA1UECAwPTmV3IFNvdXRoIFdhbGVzMQ8wDQYDVQQHDAZTeWRu +ZXkxITAfBgNVBAoMGEVtYWNzIFRlc3QgU2VydmljZXNzIExMQzESMBAGA1UECwwJ +QXV0b21hdGVkMRcwFQYDVQQDDA50ZXN0LmVtYWNzLnpvdDEiMCAGCSqGSIb3DQEJ +ARYTZW1hY3MtZGV2ZWxAZnNmLm9yZzAeFw0xNjAyMDgwNDA0MzJaFw0xNjAzMDkw +NDA0MzJaMIGsMQswCQYDVQQGEwJBVTEYMBYGA1UECAwPTmV3IFNvdXRoIFdhbGVz +MQ8wDQYDVQQHDAZTeWRuZXkxITAfBgNVBAoMGEVtYWNzIFRlc3QgU2VydmljZXNz +IExMQzESMBAGA1UECwwJQXV0b21hdGVkMRcwFQYDVQQDDA50ZXN0LmVtYWNzLnpv +dDEiMCAGCSqGSIb3DQEJARYTZW1hY3MtZGV2ZWxAZnNmLm9yZzCCASIwDQYJKoZI +hvcNAQEBBQADggEPADCCAQoCggEBAM52lP7k1rBpctBX1irRVgDerxqlFSTkvg8L +WmRCfwm3XY8EZWqM/8Eex5soH7myRlWfUH/cKxbqScZqXotj0hlPxdRkM6gWgHS9 +Mml7wnz2LZGvD5PfMfs+yBHKAMrqortFXCKksHsYIJ66l9gJMm1G5XjWha6CaEr/ +k2bE5Ovw0fB2B4vH0OqhJzGyenJOspXZz1ttn3h3UC5fbDXS8fUM9k/FbgJKypWr +zB3P12GcMR939FsR5sqa8nNoCMw+WBzs4XuM5Ad+s/UtEaZvmtwvLwmdB7cgCEyM +x5gaM969SlpOmuy7dDTCCK3lBl6B5dgFKvVcChYwSW+xJz5tfL0CAwEAAaNQME4w +HQYDVR0OBBYEFG3YhH7ZzEdOGstkT67uUh1RylNjMB8GA1UdIwQYMBaAFG3YhH7Z +zEdOGstkT67uUh1RylNjMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQELBQADggEB +ADnJL2tBMnPepywA57yDfJz54FvrqRd+UAjSiB7/QySDpHnTM3b3sXWfwAkXPTjM +c+jRW2kfdnL6OQW2tpcpPZANGnwK8MJrtGcbHhtPXjgDRhVZp64hsB7ayS+l0Dm7 +2ZBbi2SF8FgZVcQy0WD01ir2raSODo124dMrq+3aHP77YLbiNEKj+wFoDbndQ1FQ +gtIJBE80FADoqc7LnBrpA20aVlfqhKZqe+leYDSZ+CE1iwlPdvD+RTUxVDs5EfpB +qVOHDlzEfVmcMnddKTV8pNYuo93AG4s0KdrGG9RwSvtLaOoHd2i6RmIs+Yiumbau +mXodMxxAEW/cM7Ita/2QVmk= +-----END CERTIFICATE----- diff --git a/test/data/net/key.pem b/test/data/net/key.pem new file mode 100644 index 00000000000..5db58f573ca --- /dev/null +++ b/test/data/net/key.pem @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDOdpT+5NawaXLQ +V9Yq0VYA3q8apRUk5L4PC1pkQn8Jt12PBGVqjP/BHsebKB+5skZVn1B/3CsW6knG +al6LY9IZT8XUZDOoFoB0vTJpe8J89i2Rrw+T3zH7PsgRygDK6qK7RVwipLB7GCCe +upfYCTJtRuV41oWugmhK/5NmxOTr8NHwdgeLx9DqoScxsnpyTrKV2c9bbZ94d1Au +X2w10vH1DPZPxW4CSsqVq8wdz9dhnDEfd/RbEebKmvJzaAjMPlgc7OF7jOQHfrP1 +LRGmb5rcLy8JnQe3IAhMjMeYGjPevUpaTprsu3Q0wgit5QZegeXYBSr1XAoWMElv +sSc+bXy9AgMBAAECggEAaqHkIiGeoE5V9jTncAXeHWTlmyVX3k4luy9p6A5P/nyt +3YevuXBJRzzWatQ2Tno8yUwXD3Ju7s7ie4/EdMmBYYFJ84AtDctRXPm6Z7B7qn6a +2ntH2F+WOOUb/9QMxMCae44/H8VfQLQdZN2KPxHA8Z+ENPzW3mKL6vBE+PcIJLK2 +kTXQdCEIuUb1v4kxKYfjyyHAQ9yHvocUvZdodGHrpmWOr/2QCrqCjwiKnXyvdJMi +JQ4a3dU+JG5Zwr2hScyeLgS4p+M3A2NY+oIACn2rCcsIKC6uvBK3wAbhssaY8z9c +5kap862oMBNmPCxPuQTIIO7ptla0EWHktpFxnu7GIQKBgQDvKyXt82zGHiOZ9acx +4fV7t3NF2MNd9fOn59NYWYRSs2gaEjit6BnsCgiKZOJJ2YFsggBiQMiWuEzwqIdW +bOH8W5AubTxnE2OjeIpH5r8AXI6I/pKdOedM86oeElbL0p53OZqSqBK6vA5SnE76 +fZwC505h/mqH2E6AdKpcyL7sJwKBgQDc/jc4MkVnqF7xcYoJrYEbnkhwqRxIM+0Y +HY2qXszWQPgjae3NK1rw/PEOATzWrHLvRS/utQ8yeLUAZIGsFY8+c1kjvkvl4ZK2 +OnsEOVLmEwjDqqnq3JFYCVSkXfLBGRD3wGldzkCQljOiGuJ/Co1rGHk7CfBmxX2p +kxdts5OKewKBgQDTRsSc7Zs7cMh2a0GlmTyoa6iTHSeIy4rQ2sQimgGApSfjUBFt +30l28G4XA4O7RT9FwZnhMeWA75JYTigwOsNvkNtPiAQB8mjksclGNxqnkRwA/RI7 +fjlMCzxOkFjIeWivXd2kjIDvIM1uQNKsCWZWUks12e/1zSmb5HPSvyuZpQKBgQDQ +qVgKP604ysmav9HOgXy+Tx2nAoYpxp2/f2gbzZcrVfz1szdN2fnsQWh6CMEhEYMU +WQeBJIRM65w72qp1iYXPOaqZDT0suWiFl4I/4sBbbO2BkssNb2Xs8iJxcCOeH8Td +qVfTssNTwf7OuQPTYGtXC6ysCh5ra13Tl4cvlbdhsQKBgFHXP+919wSncLS+2ySD +waBzG6GyVOgV+FE3DrM3Xp4S6fldWYAndKHQ1HjJVDY8SkC2Tk1D7QSQnmS+ZzYs +YqzcnkPCTHLb6wCErs4ZiW0gn9xJnfxyv6wPujsayL4TMsmsqkj/IAB61UjwaA/a +Z+rUw/WkcNPD59AD1J0eeSZu +-----END PRIVATE KEY----- diff --git a/test/data/shr/div-div.html b/test/data/shr/div-div.html new file mode 100644 index 00000000000..1c191ae44d8 --- /dev/null +++ b/test/data/shr/div-div.html @@ -0,0 +1 @@ +<div>foo</div><div>Bar</div> diff --git a/test/data/shr/div-div.txt b/test/data/shr/div-div.txt new file mode 100644 index 00000000000..62715e12513 --- /dev/null +++ b/test/data/shr/div-div.txt @@ -0,0 +1,2 @@ +foo +Bar diff --git a/test/data/shr/div-p.html b/test/data/shr/div-p.html new file mode 100644 index 00000000000..fcbdfc43293 --- /dev/null +++ b/test/data/shr/div-p.html @@ -0,0 +1 @@ +<div>foo</div><p>Bar</p> diff --git a/test/data/shr/div-p.txt b/test/data/shr/div-p.txt new file mode 100644 index 00000000000..859d731da89 --- /dev/null +++ b/test/data/shr/div-p.txt @@ -0,0 +1,3 @@ +foo + +Bar diff --git a/test/data/shr/li-div.html b/test/data/shr/li-div.html new file mode 100644 index 00000000000..eca3c511bd9 --- /dev/null +++ b/test/data/shr/li-div.html @@ -0,0 +1,10 @@ +<ul> + <li> + <div> + <p >This is the first paragraph of a list item.</div> + <p >This is the second paragraph of a list item.</li> + <li> + <div>This is the first paragraph of a list item.</div> + <div>This is the second paragraph of a list item.</div> + </li> +</ul> diff --git a/test/data/shr/li-div.txt b/test/data/shr/li-div.txt new file mode 100644 index 00000000000..9fc54f2bdc6 --- /dev/null +++ b/test/data/shr/li-div.txt @@ -0,0 +1,6 @@ +* This is the first paragraph of a list item. + + This is the second paragraph of a list item. + +* This is the first paragraph of a list item. + This is the second paragraph of a list item. diff --git a/test/data/shr/li-empty.html b/test/data/shr/li-empty.html new file mode 100644 index 00000000000..05cfee7bdd4 --- /dev/null +++ b/test/data/shr/li-empty.html @@ -0,0 +1 @@ +<ol><li></li><li></li><li></li></ol> diff --git a/test/data/shr/li-empty.txt b/test/data/shr/li-empty.txt new file mode 100644 index 00000000000..906fd8df8b3 --- /dev/null +++ b/test/data/shr/li-empty.txt @@ -0,0 +1,3 @@ +1%20 +2%20 +3%20 diff --git a/test/data/shr/nonbr.html b/test/data/shr/nonbr.html new file mode 100644 index 00000000000..56282cf4ca5 --- /dev/null +++ b/test/data/shr/nonbr.html @@ -0,0 +1 @@ +<div class="gmail_extra">(progn</div><div class="gmail_extra"> (setq minibuffer-prompt-properties '(read-only t cursor-intangible t face minibuffer-prompt))</div><div class="gmail_extra"><br></div><div class="gmail_extra"> (defun turn-on-cursor-intangible-mode ()</div><div class="gmail_extra"> "Turns on cursor-intangible-mode."</div><div class="gmail_extra"> (interactive)</div><div class="gmail_extra"> (cursor-intangible-mode 1))</div><div class="gmail_extra"> (define-globalized-minor-mode global-cursor-intangible-mode cursor-intangible-mode turn-on-cursor-intangible-mode)</div><div class="gmail_extra"><br></div><div class="gmail_extra"> (global-cursor-intangible-mode 1))</div><div class="gmail_extra"><br></div> diff --git a/test/data/shr/nonbr.txt b/test/data/shr/nonbr.txt new file mode 100644 index 00000000000..0c3cffa93f9 --- /dev/null +++ b/test/data/shr/nonbr.txt @@ -0,0 +1,12 @@ +(progn + (setq minibuffer-prompt-properties '(read-only t cursor-intangible t face +minibuffer-prompt)) + + (defun turn-on-cursor-intangible-mode () + "Turns on cursor-intangible-mode." + (interactive) + (cursor-intangible-mode 1)) + (define-globalized-minor-mode global-cursor-intangible-mode +cursor-intangible-mode turn-on-cursor-intangible-mode) + + (global-cursor-intangible-mode 1)) diff --git a/test/data/shr/ul-empty.html b/test/data/shr/ul-empty.html new file mode 100644 index 00000000000..e5a75ab9216 --- /dev/null +++ b/test/data/shr/ul-empty.html @@ -0,0 +1,4 @@ +<ul> +<li></li> +</ul> +Lala diff --git a/test/data/shr/ul-empty.txt b/test/data/shr/ul-empty.txt new file mode 100644 index 00000000000..8993555425b --- /dev/null +++ b/test/data/shr/ul-empty.txt @@ -0,0 +1,3 @@ +* + +Lala
\ No newline at end of file diff --git a/test/automated/data/xref/file1.txt b/test/data/xref/file1.txt index 5d7cc544443..5d7cc544443 100644 --- a/test/automated/data/xref/file1.txt +++ b/test/data/xref/file1.txt diff --git a/test/automated/data/xref/file2.txt b/test/data/xref/file2.txt index 9f075f26004..9f075f26004 100644 --- a/test/automated/data/xref/file2.txt +++ b/test/data/xref/file2.txt diff --git a/test/file-organization.org b/test/file-organization.org new file mode 100644 index 00000000000..dba5f4ff712 --- /dev/null +++ b/test/file-organization.org @@ -0,0 +1,51 @@ +#+TITLE: The Location of Emacs-Lisp Tests + + + +* The Main Emacs Repository + +The Emacs repository contains a very large number of Emacs-Lisp files, many of +which pre-date both formal package support for Emacs and automated unit +testing. + +All paths are relative to the Emacs root directory. + +** Source + +Lisp files are stored in the ~lisp~ directory or its sub-directories. +Sub-directories are in many cases themed after packages (~gnus~, ~org~, +~calc~), related functionality (~net~, ~emacs-lisp~, ~progmodes~) or status +(~obsolete~). + +C source is stored in the ~src~ directory, which is flat. + +** Test Files + +Automated tests should be stored in the ~test/automated/lisp~ directory. Tests +should reflect the directory structure of the source tree; so tests for files +in the ~emacs-lisp~ source directory should reside in the +~test/lisp/emacs-lisp~ directory. + +Tests should normally reside in a file with ~-tests~ added to the name of +the tested source file; hence ~ert.el~ is tested in ~ert-tests.el~, or +~pcase.el~ is tested in ~pcase-tests.el~. Exceptionally, tests for a +single feature may be placed into multiple files of any name which are +themselves placed in a directory named after the feature with ~-tests~ +appended, such as ~/test/lisp/emacs-lisp/eieio-tests~ + +Where features of the C source are tested using Emacs-Lisp test files, these +should reside in ~/test/src~ and be named after the C file. + +There are also some test materials that cannot be run automatically +(i.e. via ert). These should be placed in ~/test/manual~ + +** Resource Files + +Resource files for tests (containing test data) should reside in a directory +named after the feature with a ~-resources~ suffix, and located in the same +directory as the feature. Hence, the lisp file ~flymake.el~ should have test +files in ~/test/automated/lisp/progmodes/flymake-tests.el~ should reside in a +directory called ~/test/automated/lisp/progmodes/flymake-resources~. + +No guidance is given for the organization of resource files inside the +~-resource~ directory; files can be organized at the author's discretion. diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el new file mode 100644 index 00000000000..c747e19db88 --- /dev/null +++ b/test/lisp/abbrev-tests.el @@ -0,0 +1,255 @@ +;;; abbrev-tests.el --- Test suite for abbrevs -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2016 Free Software Foundation, Inc. + +;; Author: Eli Zaretskii <eliz@gnu.org> +;; Keywords: abbrevs + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; `kill-all-abbrevs-test' will remove all user *and* system abbrevs +;; if called noninteractively with the init file loaded. + +;;; Code: + +(require 'ert) +(require 'abbrev) +(require 'seq) + +;; set up test abbrev table and abbrev entry +(defun setup-test-abbrev-table () + (defvar ert-test-abbrevs nil) + (define-abbrev-table 'ert-test-abbrevs '(("a-e-t" "abbrev-ert-test"))) + (abbrev-table-put ert-test-abbrevs :ert-test "ert-test-value") + ert-test-abbrevs) + +(ert-deftest abbrev-table-p-test () + (should-not (abbrev-table-p 42)) + (should-not (abbrev-table-p "aoeu")) + (should-not (abbrev-table-p '())) + (should-not (abbrev-table-p [])) + ;; Missing :abbrev-table-modiff counter: + (should-not (abbrev-table-p (obarray-make))) + (let* ((table (obarray-make))) + (should (abbrev-table-empty-p (make-abbrev-table))))) + +(ert-deftest abbrev-make-abbrev-table-test () + ;; Table without properties: + (let ((table (make-abbrev-table))) + (should (abbrev-table-p table)) + (should (= (length table) obarray-default-size))) + ;; Table with one property 'foo with value 'bar: + (let ((table (make-abbrev-table '(foo bar)))) + (should (abbrev-table-p table)) + (should (= (length table) obarray-default-size)) + (should (eq (abbrev-table-get table 'foo) 'bar)))) + +(ert-deftest abbrev-table-get-put-test () + (let ((table (make-abbrev-table))) + (should-not (abbrev-table-get table 'foo)) + (should (= (abbrev-table-put table 'foo 42) 42)) + (should (= (abbrev-table-get table 'foo) 42)) + (should (eq (abbrev-table-put table 'foo 'bar) 'bar)) + (should (eq (abbrev-table-get table 'foo) 'bar)))) + +(ert-deftest copy-abbrev-table-test () + (defvar foo-abbrev-table nil) ; Avoid compiler warning + (define-abbrev-table 'foo-abbrev-table + '()) + (should (abbrev-table-p foo-abbrev-table)) + ;; Bug 21828 + (let ((new-foo-abbrev-table + (condition-case nil + (copy-abbrev-table foo-abbrev-table) + (error nil)))) + (should (abbrev-table-p new-foo-abbrev-table))) + (should-not (string-equal (buffer-name) "*Backtrace*"))) + +(ert-deftest abbrev-table-empty-p-test () + (should-error (abbrev-table-empty-p 42)) + (should-error (abbrev-table-empty-p "aoeu")) + (should-error (abbrev-table-empty-p '())) + (should-error (abbrev-table-empty-p [])) + ;; Missing :abbrev-table-modiff counter: + (should-error (abbrev-table-empty-p (obarray-make))) + (let* ((table (obarray-make))) + (abbrev-table-put table :abbrev-table-modiff 42) + (should (abbrev-table-empty-p table)))) + +(ert-deftest kill-all-abbrevs-test () + "Test undefining all defined abbrevs" + (unless noninteractive + (ert-skip "Cannot test kill-all-abbrevs in interactive mode")) + + (let ((num-tables 0)) + ;; ensure at least one abbrev exists + (should (abbrev-table-p (setup-test-abbrev-table))) + (setf num-tables (length abbrev-table-name-list)) + (kill-all-abbrevs) + + ;; no tables should have been removed/added + (should (= num-tables (length abbrev-table-name-list))) + ;; number of empty tables should be the same as number of tables + (should (= num-tables (length (seq-filter + (lambda (table) + (abbrev-table-empty-p (symbol-value table))) + abbrev-table-name-list)))))) + +(ert-deftest abbrev-table-name-test () + "Test returning name of abbrev-table" + (let ((ert-test-abbrevs (setup-test-abbrev-table)) + (no-such-table nil)) + (should (equal 'ert-test-abbrevs (abbrev-table-name ert-test-abbrevs))) + (should (equal nil (abbrev-table-name no-such-table))))) + +(ert-deftest clear-abbrev-table-test () + "Test clearing single abbrev table" + (let ((ert-test-abbrevs (setup-test-abbrev-table))) + (should (equal "abbrev-ert-test" (abbrev-expansion "a-e-t" ert-test-abbrevs))) + (clear-abbrev-table ert-test-abbrevs) + (should (equal nil (abbrev-expansion "a-e-t" ert-test-abbrevs))) + (should (equal t (abbrev-table-empty-p ert-test-abbrevs))))) + +(ert-deftest list-abbrevs-test () + "Test generation of abbrev list buffer" + ;; Somewhat redundant as prepare-abbrev-list-buffer is also tested. + ;; all abbrevs + (let ((abbrev-buffer (prepare-abbrev-list-buffer))) + (should (equal "*Abbrevs*" (buffer-name abbrev-buffer))) + (kill-buffer abbrev-buffer)) + ;; mode-specific abbrevs + (let ((abbrev-buffer (prepare-abbrev-list-buffer t))) + (should (equal "*Abbrevs*" (buffer-name abbrev-buffer))) + (kill-buffer abbrev-buffer))) + +(ert-deftest prepare-abbrev-list-buffer-test () + "Test generation of abbrev list buffer" + ;; all abbrevs + (let ((ert-test-abbrevs (setup-test-abbrev-table))) + (with-current-buffer (prepare-abbrev-list-buffer) + ;; Check for a couple of abbrev-table names in buffer. + (should (and (progn + (goto-char (point-min)) + (search-forward (symbol-name (abbrev-table-name ert-test-abbrevs)))) + (progn + (goto-char (point-min)) + (search-forward "global-abbrev-table")))) + (should (equal 'edit-abbrevs-mode major-mode)) + (kill-buffer "*Abbrevs*"))) + + ;; mode-specific abbrevs (temp buffer uses fundamental-mode) + (with-temp-buffer + (prepare-abbrev-list-buffer t) + (with-current-buffer "*Abbrevs*" + (should (progn + (goto-char (point-min)) + (search-forward "fundamental-mode-abbrev-table"))) + (should-error (progn + (goto-char (point-min)) + (search-forward "global-abbrev-table"))) + (should-not (equal 'edit-abbrevs-mode major-mode)) + (kill-buffer "*Abbrevs*")))) + +(ert-deftest insert-abbrevs-test () + "Test inserting abbrev definitions into buffer" + (with-temp-buffer + (insert-abbrevs) + (should (progn + (goto-char (point-min)) + (search-forward "global-abbrev-table"))))) + +(ert-deftest edit-abbrevs-test () + "Test editing abbrevs from buffer" + (defvar ert-edit-abbrevs-test-table nil) + (let ((ert-test-abbrevs (setup-test-abbrev-table))) + (with-temp-buffer + ;; insert test table and new abbrev, redefine, check definition + (goto-char (point-min)) + (insert "(ert-edit-abbrevs-test-table)\n") + (insert "\n" "\"e-a-t\"\t" "0\t" "\"edit-abbrevs-test\"\n") + ;; check test table before redefine + (should (equal "abbrev-ert-test" + (abbrev-expansion "a-e-t" ert-test-abbrevs))) + (edit-abbrevs-redefine) + (should-not (abbrev-expansion "a-e-t" ert-test-abbrevs)) + (should (equal "edit-abbrevs-test" + (abbrev-expansion "e-a-t" ert-edit-abbrevs-test-table)))))) + +(ert-deftest define-abbrevs-test () + "Test defining abbrevs from buffer" + (defvar ert-bad-abbrev-table nil) + (defvar ert-good-abbrev-table nil) + (defvar ert-redefine-abbrev-table nil) + (with-temp-buffer + ;; insert bad abbrev data and attempt define + (goto-char (point-min)) + (insert "ert-bad-abbrev-table\n") + (insert "\n" "\"b-a-t\"\t" "0\t" "\n") + (should-not (define-abbrevs)) + (should (equal nil (abbrev-expansion "b-a-t" ert-bad-abbrev-table))) + (delete-region (point-min) (point-max)) + ;; try with valid abbrev data + (goto-char (point-min)) + (insert "(ert-good-abbrev-table)\n") + (insert "\n" "\"g-a-t\"\t" "0\t" "\"good-abbrev-table\"\n") + (define-abbrevs) + (should (equal "good-abbrev-table" + (abbrev-expansion "g-a-t" ert-good-abbrev-table))) + ;; redefine from buffer + (delete-region (point-min) (point-max)) + (insert "(ert-redefine-abbrev-table)\n") + (insert "\n" "\"r-a-t\"\t" "0\t" "\"redefine-abbrev-table\"\n") + ;; arg = kill-all-abbrevs + (define-abbrevs t) + (should (equal "redefine-abbrev-table" + (abbrev-expansion "r-a-t" ert-redefine-abbrev-table))) + (should (equal nil (abbrev-expansion "g-a-t" ert-good-abbrev-table))))) + +(ert-deftest read-write-abbrev-file-test () + "Test reading and writing abbrevs from file" + (let ((temp-test-file (make-temp-file "ert-abbrev-test")) + (ert-test-abbrevs (setup-test-abbrev-table))) + (write-abbrev-file temp-test-file) + (clear-abbrev-table ert-test-abbrevs) + (should (abbrev-table-empty-p ert-test-abbrevs)) + (read-abbrev-file temp-test-file) + (should (equal "abbrev-ert-test" (abbrev-expansion "a-e-t" ert-test-abbrevs))) + (delete-file temp-test-file))) + +(ert-deftest abbrev-edit-save-to-file-test () + "Test saving abbrev definitions in buffer to file" + (defvar ert-save-test-table nil) + (let ((temp-test-file (make-temp-file "ert-abbrev-test")) + (ert-test-abbrevs (setup-test-abbrev-table))) + (with-temp-buffer + (goto-char (point-min)) + (insert "(ert-save-test-table)\n") + (insert "\n" "\"s-a-t\"\t" "0\t" "\"save-abbrevs-test\"\n") + (should (equal "abbrev-ert-test" + (abbrev-expansion "a-e-t" ert-test-abbrevs))) + ;; clears abbrev tables + (abbrev-edit-save-to-file temp-test-file) + (should-not (abbrev-expansion "a-e-t" ert-test-abbrevs)) + (read-abbrev-file temp-test-file) + (should (equal "save-abbrevs-test" + (abbrev-expansion "s-a-t" ert-save-test-table))) + (delete-file temp-test-file)))) + +(provide 'abbrev-tests) + +;;; abbrev-tests.el ends here diff --git a/test/automated/auth-source-tests.el b/test/lisp/auth-source-tests.el index 5faa1fe20bf..5faa1fe20bf 100644 --- a/test/automated/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el diff --git a/test/automated/auto-revert-tests.el b/test/lisp/autorevert-tests.el index a6f8cb29563..2f951c0c9aa 100644 --- a/test/automated/auto-revert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -156,7 +156,76 @@ (ignore-errors (delete-directory tmpdir1 'recursive)) (ignore-errors (delete-directory tmpdir2 'recursive))))) -(ert-deftest auto-revert-test02-auto-revert-tail-mode () +;; This is inspired by Bug#23276. +(ert-deftest auto-revert-test02-auto-revert-deleted-file () + "Check autorevert for a deleted file." + :tags '(:expensive-test) + + (let ((tmpfile (make-temp-file "auto-revert-test")) + buf) + (unwind-protect + (progn + (with-current-buffer (get-buffer-create "*Messages*") + (narrow-to-region (point-max) (point-max))) + (write-region "any text" nil tmpfile nil 'no-message) + (setq buf (find-file-noselect tmpfile)) + (with-current-buffer buf + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that + ;; it returns nil. + (sleep-for 1) + (auto-revert-mode 1) + (should auto-revert-mode) + + ;; Remove file while reverting. We simulate this by + ;; modifying `before-revert-hook'. + (add-hook + 'before-revert-hook + (lambda () (delete-file buffer-file-name)) + nil t) + (with-current-buffer (get-buffer-create "*Messages*") + (narrow-to-region (point-max) (point-max))) + (sleep-for 1) + (write-region "another text" nil tmpfile nil 'no-message) + + ;; Check, that the buffer hasn't been reverted. File + ;; notification should be disabled, falling back to + ;; polling. + (auto-revert--wait-for-revert buf) + (should (string-match "any text" (buffer-string))) + (should-not auto-revert-use-notify) + + ;; Once the file has been recreated, the buffer shall be + ;; reverted. + (kill-local-variable 'before-revert-hook) + (with-current-buffer (get-buffer-create "*Messages*") + (narrow-to-region (point-max) (point-max))) + (sleep-for 1) + (write-region "another text" nil tmpfile nil 'no-message) + + ;; Check, that the buffer has been reverted. + (auto-revert--wait-for-revert buf) + (should (string-match "another text" (buffer-string))) + + ;; An empty file shall still be reverted. + (with-current-buffer (get-buffer-create "*Messages*") + (narrow-to-region (point-max) (point-max))) + (sleep-for 1) + (write-region "" nil tmpfile nil 'no-message) + + ;; Check, that the buffer has been reverted. + (auto-revert--wait-for-revert buf) + (should (string-equal "" (buffer-string))))) + + ;; Exit. + (with-current-buffer "*Messages*" (widen)) + (ignore-errors + (with-current-buffer buf (set-buffer-modified-p nil)) + (kill-buffer buf)) + (ignore-errors (delete-file tmpfile))))) + +(ert-deftest auto-revert-test03-auto-revert-tail-mode () "Check autorevert tail mode." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. @@ -194,7 +263,7 @@ (ignore-errors (kill-buffer buf)) (ignore-errors (delete-file tmpfile))))) -(ert-deftest auto-revert-test03-auto-revert-mode-dired () +(ert-deftest auto-revert-test04-auto-revert-mode-dired () "Check autorevert for dired." ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. diff --git a/test/lisp/buff-menu-tests.el b/test/lisp/buff-menu-tests.el new file mode 100644 index 00000000000..5bfdfba7a21 --- /dev/null +++ b/test/lisp/buff-menu-tests.el @@ -0,0 +1,45 @@ +;;; buff-menu-tests.el --- Test suite for buff-menu.el -*- lexical-binding: t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Tino Calancha <tino.calancha@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) + +(ert-deftest buff-menu-24962 () + "Test for http://debbugs.gnu.org/24962 ." + (let ((file (expand-file-name "foo" temporary-file-directory)) + buf) + (unwind-protect + (progn + (write-region "foo" nil file) + (setq buf (find-file file)) + (rename-buffer " foo") + (list-buffers) + (with-current-buffer "*Buffer List*" + (should (string= " foo" (buffer-name (Buffer-menu-buffer)))))) + (and (buffer-live-p buf) (kill-buffer buf)) + (and (file-exists-p file) (delete-file file))))) + +(provide 'buff-menu-tests) + +;;; buff-menu-tests.el ends here diff --git a/test/automated/calc-tests.el b/test/lisp/calc/calc-tests.el index c1fb1695c78..c1fb1695c78 100644 --- a/test/automated/calc-tests.el +++ b/test/lisp/calc/calc-tests.el diff --git a/test/automated/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 2c13a363213..307d687f2af 100644 --- a/test/automated/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -58,23 +58,16 @@ (ert-deftest icalendar--create-uid () "Test for `icalendar--create-uid'." (let* ((icalendar-uid-format "xxx-%t-%c-%h-%u-%s") - t-ct (icalendar--uid-count 77) (entry-full "30.06.1964 07:01 blahblah") (hash (format "%d" (abs (sxhash entry-full)))) (contents "DTSTART:19640630T070100\nblahblah") - (username (or user-login-name "UNKNOWN_USER")) - ) - (fset 't-ct (symbol-function 'current-time)) - (unwind-protect - (progn - (fset 'current-time (lambda () '(1 2 3))) - (should (= 77 icalendar--uid-count)) - (should (string= (concat "xxx-123-77-" hash "-" username "-19640630") - (icalendar--create-uid entry-full contents))) - (should (= 78 icalendar--uid-count))) - ;; restore 'current-time - (fset 'current-time (symbol-function 't-ct))) + (username (or user-login-name "UNKNOWN_USER"))) + (cl-letf (((symbol-function 'current-time) (lambda () '(1 2 3)))) + (should (= 77 icalendar--uid-count)) + (should (string= (concat "xxx-123-77-" hash "-" username "-19640630") + (icalendar--create-uid entry-full contents))) + (should (= 78 icalendar--uid-count))) (setq contents "blahblah") (setq icalendar-uid-format "yyy%syyy") (should (string= (concat "yyyDTSTARTyyy") @@ -1264,6 +1257,50 @@ UID:8814e3f9-7482-408f-996c-3bfe486a1263 UID: 8814e3f9-7482-408f-996c-3bfe486a1263 ")) +(ert-deftest icalendar-import-bug-24199 () + ;;bug#24199 -- monthly rule with byday-clause + (icalendar-tests--test-import +" +SUMMARY:Summary +DESCRIPTION:Desc +LOCATION:Loc +DTSTART:20151202T124600 +DTEND:20151202T160000 +RRULE:FREQ=MONTHLY;BYDAY=1WE;INTERVAL=1 +EXDATE:20160106T114600Z +EXDATE:20160203T114600Z +EXDATE:20160302T114600Z +EXDATE:20160504T104600Z +EXDATE:20160601T104600Z +CLASS:DEFAULT +TRANSP:OPAQUE +BEGIN:VALARM +ACTION:DISPLAY +TRIGGER;VALUE=DURATION:-PT3H +END:VALARM +LAST-MODIFIED:20160805T191040Z +UID:9188710a-08a7-4061-bae3-d4cf4972599a +" +"&%%(and (not (diary-date 2016 1 6)) (not (diary-date 2016 2 3)) (not (diary-date 2016 3 2)) (not (diary-date 2016 5 4)) (not (diary-date 2016 6 1)) (diary-float t 3 1) (diary-block 2015 12 2 9999 1 1)) 12:46-16:00 Summary + Desc: Desc + Location: Loc + Class: DEFAULT + UID: 9188710a-08a7-4061-bae3-d4cf4972599a +" +"&%%(and (not (diary-date 6 1 2016)) (not (diary-date 3 2 2016)) (not (diary-date 2 3 2016)) (not (diary-date 4 5 2016)) (not (diary-date 1 6 2016)) (diary-float t 3 1) (diary-block 2 12 2015 1 1 9999)) 12:46-16:00 Summary + Desc: Desc + Location: Loc + Class: DEFAULT + UID: 9188710a-08a7-4061-bae3-d4cf4972599a +" +"&%%(and (not (diary-date 1 6 2016)) (not (diary-date 2 3 2016)) (not (diary-date 3 2 2016)) (not (diary-date 5 4 2016)) (not (diary-date 6 1 2016)) (diary-float t 3 1) (diary-block 12 2 2015 1 1 9999)) 12:46-16:00 Summary + Desc: Desc + Location: Loc + Class: DEFAULT + UID: 9188710a-08a7-4061-bae3-d4cf4972599a +" +)) + (ert-deftest icalendar-import-multiple-vcalendars () (icalendar-tests--test-import "DTSTART;VALUE=DATE:20110723 diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el new file mode 100644 index 00000000000..6dc23372f24 --- /dev/null +++ b/test/lisp/calendar/parse-time-tests.el @@ -0,0 +1,65 @@ +;; parse-time-tests.el --- Test suite for parse-time.el + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Lars Ingebrigtsen <larsi@gnus.org> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'parse-time) + +(ert-deftest parse-time-tests () + (should (equal (parse-time-string "Mon, 22 Feb 2016 19:35:42 +0100") + '(42 35 19 22 2 2016 1 nil 3600))) + (should (equal (parse-time-string "22 Feb 2016 19:35:42 +0100") + '(42 35 19 22 2 2016 nil nil 3600))) + (should (equal (parse-time-string "22 Feb 2016 +0100") + '(nil nil nil 22 2 2016 nil nil 3600))) + (should (equal (parse-time-string "Mon, 22 Feb 16 19:35:42 +0100") + '(42 35 19 22 2 2016 1 nil 3600))) + (should (equal (parse-time-string "Mon, 22 February 2016 19:35:42 +0100") + '(42 35 19 22 2 2016 1 nil 3600))) + (should (equal (parse-time-string "Mon, 22 feb 2016 19:35:42 +0100") + '(42 35 19 22 2 2016 1 nil 3600))) + (should (equal (parse-time-string "Monday, 22 february 2016 19:35:42 +0100") + '(42 35 19 22 2 2016 1 nil 3600))) + (should (equal (parse-time-string "Monday, 22 february 2016 19:35:42 PDT") + '(42 35 19 22 2 2016 1 t -25200))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0200") + '(13818 33666))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0230") + '(13818 35466))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-02:00") + '(13818 33666))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-02") + '(13818 33666))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54+0230") + '(13818 17466))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54+02") + '(13818 19266))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54Z") + '(13818 26466))) + (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54") + (encode-time 54 21 12 12 9 1998)))) + +(provide 'parse-time-tests) + +;;; parse-time-tests.el ends here diff --git a/test/automated/char-fold-tests.el b/test/lisp/char-fold-tests.el index 485254aa6cf..485254aa6cf 100644 --- a/test/automated/char-fold-tests.el +++ b/test/lisp/char-fold-tests.el diff --git a/test/automated/comint-testsuite.el b/test/lisp/comint-tests.el index 576be238408..576be238408 100644 --- a/test/automated/comint-testsuite.el +++ b/test/lisp/comint-tests.el diff --git a/test/automated/dabbrev-tests.el b/test/lisp/dabbrev-tests.el index 9c7a8385535..9c7a8385535 100644 --- a/test/automated/dabbrev-tests.el +++ b/test/lisp/dabbrev-tests.el diff --git a/test/automated/descr-text-test.el b/test/lisp/descr-text-tests.el index 9e851c3a119..9e851c3a119 100644 --- a/test/automated/descr-text-test.el +++ b/test/lisp/descr-text-tests.el diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el new file mode 100644 index 00000000000..6dd4bb91bc2 --- /dev/null +++ b/test/lisp/dired-tests.el @@ -0,0 +1,56 @@ +;;; dired-tests.el --- Test suite. -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: +(require 'ert) +(require 'dired) + + +(ert-deftest dired-autoload () + "Tests to see whether dired-x has been autoloaded" + (should + (fboundp 'dired-jump)) + (should + (autoloadp + (symbol-function + 'dired-jump)))) + +(ert-deftest dired-test-bug22694 () + "Test for http://debbugs.gnu.org/22694 ." + (let* ((dir (expand-file-name "bug22694" default-directory)) + (file "test") + (full-name (expand-file-name file dir)) + (regexp "bar") + (dired-always-read-filesystem t)) + (if (file-exists-p dir) + (delete-directory dir 'recursive)) + (make-directory dir) + (with-temp-file full-name (insert "foo")) + (find-file-noselect full-name) + (dired dir) + (with-temp-file full-name (insert "bar")) + (dired-mark-files-containing-regexp regexp) + (unwind-protect + (should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark) + `(t ,full-name))) + ;; Clean up + (delete-directory dir 'recursive)))) + +(provide 'dired-tests) +;; dired-tests.el ends here diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el new file mode 100644 index 00000000000..ca6bfbf84b5 --- /dev/null +++ b/test/lisp/dom-tests.el @@ -0,0 +1,201 @@ +;;; dom-tests.el --- Tests for dom.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl <simenheg@gmail.com> +;; Keywords: + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'dom) +(require 'ert) +(require 'subr-x) + +(defun dom-tests--tree () + "Return a DOM tree for testing." + (dom-node "html" nil + (dom-node "head" nil + (dom-node "title" nil + "Test")) + (dom-node "body" nil + (dom-node "div" '((class . "foo") + (style . "color: red;")) + (dom-node "p" '((id . "bar")) + "foo")) + (dom-node "div" '((title . "2nd div")) + "bar")))) + +(ert-deftest dom-tests-tag () + (let ((dom (dom-tests--tree))) + (should (equal (dom-tag dom) "html")) + (should (equal (dom-tag (car (dom-children dom))) "head")))) + +(ert-deftest dom-tests-attributes () + (let ((dom (dom-tests--tree))) + (should-not (dom-attributes dom)) + (should (equal (dom-attributes (dom-by-class dom "foo")) + '((class . "foo") (style . "color: red;")))))) + +(ert-deftest dom-tests-children () + (let ((dom (dom-tests--tree))) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "body"))) + (should (equal (dom-tag (dom-children (dom-children dom))) + "title")))) + +(ert-deftest dom-tests-non-text-children () + (let ((dom (dom-tests--tree))) + (should (equal (dom-children dom) (dom-non-text-children dom))) + (should-not (dom-non-text-children + (dom-children (dom-children dom)))))) + +(ert-deftest dom-tests-set-attributes () + (let ((dom (dom-tests--tree)) + (attributes '((xmlns "http://www.w3.org/1999/xhtml")))) + (should-not (dom-attributes dom)) + (dom-set-attributes dom attributes) + (should (equal (dom-attributes dom) attributes)))) + +(ert-deftest dom-tests-set-attribute () + (let ((dom (dom-tests--tree)) + (attr 'xmlns) + (value "http://www.w3.org/1999/xhtml")) + (should-not (dom-attributes dom)) + (dom-set-attribute dom attr value) + (should (equal (dom-attr dom attr) value)))) + +(ert-deftest dom-tests-attr () + (let ((dom (dom-tests--tree))) + (should-not (dom-attr dom 'id)) + (should (equal (dom-attr (dom-by-id dom "bar") 'id) "bar")))) + +(ert-deftest dom-tests-text () + (let ((dom (dom-tests--tree))) + (should (string-empty-p (dom-text dom))) + (should (equal (dom-text (dom-by-tag dom "title")) "Test")))) + +(ert-deftest dom-tests-texts () + (let ((dom (dom-tests--tree))) + (should (equal (dom-texts dom) "Test foo bar")) + (should (equal (dom-texts dom ", ") "Test, foo, bar")))) + +(ert-deftest dom-tests-child-by-tag () + (let ((dom (dom-tests--tree))) + (should (equal (dom-child-by-tag dom "head") + (car (dom-children dom)))) + (should-not (dom-child-by-tag dom "title")))) + +(ert-deftest dom-tests-by-tag () + (let ((dom (dom-tests--tree))) + (should (= (length (dom-by-tag dom "div")) 2)) + (should-not (dom-by-tag dom "article")))) + +(ert-deftest dom-tests-strings () + (let ((dom (dom-tests--tree))) + (should (equal (dom-strings dom) '("Test" "foo" "bar"))) + (should (equal (dom-strings (dom-children dom)) '("Test"))))) + +(ert-deftest dom-tests-by-class () + (let ((dom (dom-tests--tree))) + (should (equal (dom-tag (dom-by-class dom "foo")) "div")) + (should-not (dom-by-class dom "bar")))) + +(ert-deftest dom-tests-by-style () + (let ((dom (dom-tests--tree))) + (should (equal (dom-tag (dom-by-style dom "color")) "div")) + (should-not (dom-by-style dom "width")))) + +(ert-deftest dom-tests-by-id () + (let ((dom (dom-tests--tree))) + (should (equal (dom-tag (dom-by-id dom "bar")) "p")) + (should-not (dom-by-id dom "foo")))) + +(ert-deftest dom-tests-elements () + (let ((dom (dom-tests--tree))) + (should (equal (dom-elements dom 'class "foo") + (dom-by-class dom "foo"))) + (should (equal (dom-attr (dom-elements dom 'title "2nd") 'title) + "2nd div")))) + +(ert-deftest dom-tests-remove-node () + (let ((dom (dom-tests--tree))) + (should-not (dom-remove-node dom dom)) + (should (= (length (dom-children dom)) 2)) + (dom-remove-node dom (car (dom-children dom))) + (should (= (length (dom-children dom)) 1)) + (dom-remove-node dom (car (dom-children dom))) + (should-not (dom-children dom)))) + +(ert-deftest dom-tests-parent () + (let ((dom (dom-tests--tree))) + (should-not (dom-parent dom dom)) + (should (equal (dom-parent dom (car (dom-children dom))) dom)))) + +(ert-deftest dom-tests-previous-sibling () + (let ((dom (dom-tests--tree))) + (should-not (dom-previous-sibling dom dom)) + (let ((children (dom-children dom))) + (should (equal (dom-previous-sibling dom (cadr children)) + (car children)))))) + +(ert-deftest dom-tests-append-child () + (let ((dom (dom-tests--tree))) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "body"))) + (dom-append-child dom (dom-node "feet")) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "body" "feet"))))) + +(ert-deftest dom-tests-add-child-before () + "Test `dom-add-child-before'. +Tests the cases of adding a new first-child and mid-child. Also +checks that an attempt to add a new node before a non-existent +child results in an error." + (let ((dom (dom-tests--tree))) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "body"))) + (dom-add-child-before dom (dom-node "neck") + (dom-child-by-tag dom "body")) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "neck" "body"))) + (dom-add-child-before dom (dom-node "hat")) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("hat" "head" "neck" "body"))) + (should-error (dom-add-child-before dom (dom-node "neck") + (dom-by-id dom "bar"))))) + +(ert-deftest dom-tests-ensure-node () + (let ((node (dom-node "foo"))) + (should (equal (dom-ensure-node '("foo")) node)) + (should (equal (dom-ensure-node '(("foo"))) node)) + (should (equal (dom-ensure-node '("foo" nil)) node)) + (should (equal (dom-ensure-node '(("foo") nil)) node)))) + +(ert-deftest dom-tests-pp () + (let ((node (dom-node "foo" nil ""))) + (with-temp-buffer + (dom-pp node) + (should (equal (buffer-string) "(\"foo\" nil\n \"\")"))) + (with-temp-buffer + (dom-pp node t) + (should (equal (buffer-string) "(\"foo\" nil)"))))) + +(provide 'dom-tests) +;;; dom-tests.el ends here diff --git a/test/automated/electric-tests.el b/test/lisp/electric-tests.el index afd707667b8..17b4e024ab2 100644 --- a/test/automated/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -578,6 +578,7 @@ baz\"\"" (define-electric-pair-test autowrapping-7 "foo" "\"" :expected-string "``foo''" :expected-point 8 :modes '(tex-mode) + :test-in-comments nil :fixture-fn #'(lambda () (electric-pair-mode 1) (goto-char (point-max)) diff --git a/test/automated/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 48211f03ba4..91d438eae0f 100644 --- a/test/automated/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1,8 +1,9 @@ -;;; bytecomp-testsuite.el +;;; bytecomp-tests.el ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. -;; Author: Shigeru Fukaya <shigeru.fukaya@gmail.com> +;; Author: Shigeru Fukaya <shigeru.fukaya@gmail.com> +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Created: November 2008 ;; Keywords: internal ;; Human-Keywords: internal @@ -420,10 +421,50 @@ Subtests signal errors if something goes wrong." (defun def () (m)))) (should (equal (funcall 'def) 4))) +(defconst bytecomp-lexbind-tests + `( + (let ((f #'car)) + (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) + (funcall f '(1 . 2)))) + ) + "List of expression for test. +Each element will be executed by interpreter and with +bytecompiled code, and their results compared.") + +(defun bytecomp-lexbind-check-1 (pat) + "Return non-nil if PAT is the same whether directly evalled or compiled." + (let ((warning-minimum-log-level :emergency) + (byte-compile-warnings nil) + (v0 (condition-case nil + (eval pat t) + (error nil))) + (v1 (condition-case nil + (funcall (let ((lexical-binding t)) + (byte-compile `(lambda nil ,pat)))) + (error nil)))) + (equal v0 v1))) + +(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1) + +(defun bytecomp-lexbind-explain-1 (pat) + (let ((v0 (condition-case nil + (eval pat t) + (error nil))) + (v1 (condition-case nil + (funcall (let ((lexical-binding t)) + (byte-compile (list 'lambda nil pat)))) + (error nil)))) + (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." + pat v0 v1))) + +(ert-deftest bytecomp-lexbind-tests () + "Test the Emacs byte compiler lexbind handling." + (dolist (pat bytecomp-lexbind-tests) + (should (bytecomp-lexbind-check-1 pat)))) ;; Local Variables: ;; no-byte-compile: t ;; End: -(provide 'byte-opt-testsuite) - +(provide 'bytecomp-tests) +;; bytecomp-tests.el ends here. diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el new file mode 100644 index 00000000000..02db88c17e2 --- /dev/null +++ b/test/lisp/emacs-lisp/checkdoc-tests.el @@ -0,0 +1,53 @@ +;;; checkdoc-tests.el --- unit tests for checkdoc.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Google 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for lisp/emacs-lisp/checkdoc.el. + +;;; Code: + +(require 'checkdoc) + +(require 'elisp-mode) +(require 'ert) + +(ert-deftest checkdoc-tests--bug-24998 () + "Checks that Bug#24998 is fixed." + (with-temp-buffer + (emacs-lisp-mode) + (insert "(defun foo())") + (should-error (checkdoc-defun) :type 'user-error))) + +(ert-deftest checkdoc-tests--next-docstring () + "Checks that the one-argument form of `defvar' works. +See the comments in Bug#24998." + (with-temp-buffer + (emacs-lisp-mode) + (insert "(defvar foo) +\(defvar foo bar \"baz\") +\(require 'foo)") + (goto-char (point-min)) + (should (checkdoc-next-docstring)) + (should (looking-at-p "\"baz\")")) + (should-not (checkdoc-next-docstring)))) + +;;; checkdoc-tests.el ends here diff --git a/test/automated/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index dee10fe285e..dee10fe285e 100644 --- a/test/automated/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el diff --git a/test/automated/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index cbaf70fc4bb..cbaf70fc4bb 100644 --- a/test/automated/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el new file mode 100644 index 00000000000..02d9246db21 --- /dev/null +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -0,0 +1,307 @@ +;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2016 Free Software Foundation, Inc. + +;; Author: Nicolas Richard <youngfrog@members.fsf.org> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'cl-seq) + +(ert-deftest cl-union-test-00 () + "Test for http://debbugs.gnu.org/22729 ." + (let ((str1 "foo") + (str2 (make-string 3 ?o))) + ;; Emacs may make two string literals eql when reading. + (aset str2 0 ?f) + (should (not (eql str1 str2))) + (should (equal str1 str2)) + (should (equal (cl-union (list str1) (list str2)) + (list str2))) + (should (equal (cl-union (list str1) (list str2) :test 'eql) + (list str1 str2))))) + +(defvar cl-seq--test-list nil + "List used on `cl-seq' tests with side effects.") +(defvar cl-seq--test-list2 nil + "List used on `cl-seq' tests with side effects.") + +(defmacro cl-seq--with-side-effects (list list2 &rest body) + "Run a test with side effects on lists; after the test restore the lists. +LIST is the value of `cl-seq--test-list' before the test. +LIST2, if non-nil, is the value of `cl-seq--test-list2' before the test. +Body are forms defining the test." + (declare (indent 2) (debug t)) + (let ((orig (make-symbol "orig")) + (orig2 (make-symbol "orig2"))) + `(let ((,orig (copy-sequence ,list)) + (,orig2 (copy-sequence ,list2))) + (unwind-protect (progn ,@body) + (setq cl-seq--test-list ,orig) + (when ,list2 + (setq cl-seq--test-list2 ,orig2)))))) + +;; keywords supported: :start :end +(ert-deftest cl-seq-fill-test () + (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) + (orig (copy-sequence cl-seq--test-list)) + (tests '((should (equal '(b b b b b b b) (cl-fill _list 'b))) + (should (equal '(1 2 3 4 b b b) (cl-fill _list 'b :start 4))) + (should (equal '(b b b b 5 2 6) (cl-fill _list 'b :end 4))) + (should (equal '(1 2 b b 5 2 6) (cl-fill _list 'b :start 2 :end 4))) + (should (equal orig (cl-fill _list 'b :end 0)))))) + (dolist (test tests) + (let ((_list cl-seq--test-list)) + (cl-seq--with-side-effects orig nil + test))))) + +;; keywords supported: :start1 :end1 :start2 :end2 +(ert-deftest cl-seq-replace-test () + (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) + (cl-seq--test-list2 (make-list 6 'a)) + (orig (copy-sequence cl-seq--test-list)) + (orig2 (copy-sequence cl-seq--test-list2)) + (tests '((should (equal '(a a a a a a 6) (cl-replace _list _list2))) + (should (equal '(a a a a a a 6) (cl-replace _list _list2 :start1 0))) + (should (equal '(a a a a a a 6) (cl-replace _list _list2 :start2 0))) + (should (equal orig (cl-replace _list _list2 :start1 (length _list)))) + (should (equal orig (cl-replace _list _list2 :start2 (length _list2)))) + (should (equal orig (cl-replace _list _list2 :end1 0))) + (should (equal orig (cl-replace _list _list2 :end2 0))) + (should (equal '(1 2 3 4 a a a) (cl-replace _list _list2 :start1 4))) + (should (equal '(a a a a 5 2 6) (cl-replace _list _list2 :end1 4))) + (should (equal '(a a 3 4 5 2 6) (cl-replace _list _list2 :start2 4))) + (should (equal '(a a a a 5 2 6) (cl-replace _list _list2 :end2 4))) + (should (equal '(1 2 a a 5 2 6) (cl-replace _list _list2 :start1 2 :end1 4))) + (should (equal '(a a 3 4 5 2 6) (cl-replace _list _list2 :start2 2 :end2 4)))))) + (dolist (test tests) + (let ((_list cl-seq--test-list) + (_list2 cl-seq--test-list2)) + (cl-seq--with-side-effects orig orig2 + test))))) + +;; keywords supported: :test :test-not :key :count :start :end :from-end +(ert-deftest cl-seq-remove-test () + (let ((list '(1 2 3 4 5 2 6))) + (should (equal list (cl-remove 'foo list))) + (should (equal '(1 3 4 5 6) (cl-remove 2 list))) + (should (equal '(1 3 4 5 6) (cl-remove 2 list + :key #'identity + :test (lambda (a b) (eql a b))))) + (should (equal '(1 2 3 4 2) (cl-remove 4 list :test (lambda (a b) (> b a))))) + (should (equal '(5 6) (cl-remove 4 list :test-not (lambda (a b) (> b a))))) + (should (equal '(1 3 5) (cl-remove 'foo list :if #'cl-evenp))) + (should (equal '(2 4 2 6) (cl-remove 'foo list :if-not #'cl-evenp))) + (should (equal '(1 2 3 4 5) (cl-remove 'foo list :if #'cl-evenp :start 4))) + (should (equal '(1 2 3 4 5 6) (cl-remove 2 list :start 5 :end 6))) + (should (equal '(1 3 4 5 2 6) (cl-remove 2 list :count 1))) + (should (equal '(1 3 4 5 2 6) (cl-remove 2 list :from-end nil :count 1))) + (should (equal '(1 2 3 4 5 6) (cl-remove 2 list :from-end t :count 1))))) + +;; keywords supported: :test :test-not :key :count :start :end :from-end +(ert-deftest cl-seq-delete-test () + (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) + (orig (copy-sequence cl-seq--test-list)) + (tests '((should (equal orig (cl-delete 'foo _list))) + (should (equal '(1 3 4 5 6) (cl-delete 2 _list))) + (should (equal '(1 3 4 5 6) (cl-delete 2 _list + :key #'identity + :test (lambda (a b) (eql a b))))) + (should (equal '(1 2 3 4 2) (cl-delete 4 _list :test (lambda (a b) (> b a))))) + (should (equal '(5 6) (cl-delete 4 _list :test-not (lambda (a b) (> b a))))) + (should (equal '(1 3 5) (cl-delete 'foo _list :if #'cl-evenp))) + (should (equal '(2 4 2 6) (cl-delete 'foo _list :if-not #'cl-evenp))) + (should (equal '(1 2 3 4 5) (cl-delete 'foo _list :if #'cl-evenp :start 4))) + (should (equal '(1 2 3 4 5 6) (cl-delete 2 _list :start 5 :end 6))) + (should (equal '(1 3 4 5 2 6) (cl-delete 2 _list :count 1))) + (should (equal '(1 3 4 5 2 6) (cl-delete 2 _list :from-end nil :count 1))) + (should (equal '(1 2 3 4 5 6) (cl-delete 2 _list :from-end t :count 1)))))) + (dolist (test tests) + (let ((_list cl-seq--test-list)) + (cl-seq--with-side-effects orig nil + test))))) + +;; keywords supported: :test :test-not :key :start :end :from-end +(ert-deftest cl-seq-remove-duplicates-test () + (let ((list '(1 2 3 4 5 2 6))) + (should (equal '(1 3 4 5 2 6) (cl-remove-duplicates list))) + (should (equal '(1 2 3 4 5 6) (cl-remove-duplicates list :from-end t))) + (should (equal list (cl-remove-duplicates list :start 2))) + (should (equal list (cl-remove-duplicates list :start 2 :from-end t))) + (should (equal list (cl-remove-duplicates list :end 4))) + (should (equal '(6) (cl-remove-duplicates list :test (lambda (a b) (< a b))))) + (should (equal '(1 2 6) (cl-remove-duplicates list :test (lambda (a b) (>= a b))))) + (should (equal (cl-remove-duplicates list :test (lambda (a b) (>= a b))) + (cl-remove-duplicates list :test-not (lambda (a b) (< a b))))) + (should (equal (cl-remove-duplicates list) + (cl-remove-duplicates list :key #'number-to-string :test #'string=))) + (should (equal list + (cl-remove-duplicates list :key #'number-to-string :test #'eq))))) + +;; keywords supported: :test :test-not :key :count :start :end :from-end +(ert-deftest cl-seq-substitute-test () + (let ((list '(1 2 3 4 5 2 6))) + (should (equal '(1 b 3 4 5 b 6) (cl-substitute 'b 2 list))) + (should (equal list (cl-substitute 'b 2 list :start (length list)))) + (should (equal list (cl-substitute 'b 2 list :end 0))) + (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 list :start 2))) + (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 list :end 2))) + (should (equal list (cl-substitute 'b 2 list :start 2 :end 4))) + (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 list :count 1))) + (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 list :count 1 :from-end t))) + (should (equal list (cl-substitute 'b 2 list :count -1))) + (should (equal '(1 b 3 4 5 b 6) (cl-substitute 'b "2" list :key #'number-to-string + :test #'string=))) + (should (equal (cl-substitute 'b 2 list) + (cl-substitute 'b 2 list :test #'eq))) + (should (equal '(1 2 b b b 2 b) (cl-substitute 'b 2 list :test (lambda (a b) (< a b))))) + (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b 2 list :test (lambda (a b) (>= a b))))) + (should (equal list (cl-substitute 'b 99 list :test (lambda (a b) (< a b))))) + (should (equal (cl-substitute 'b 2 list :test (lambda (a b) (>= a b))) + (cl-substitute 'b 2 list :test-not (lambda (a b) (< a b))))) + (should (equal '(1 2 b b b 2 b) (cl-substitute 'b nil list :if (lambda (x) (> (cl-position x list) 1))))) + (should (equal '(1 b b b b b b) (cl-substitute 'b nil list :if (lambda (x) (> (cl-position x list :from-end t) 1))))) + + (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b nil list + :if-not (lambda (x) (> (cl-position x list) 1))))) + (should (equal '(b 2 3 4 5 2 6) (cl-substitute 'b nil list + :if-not (lambda (x) (> (cl-position x list :from-end t) 1))))))) + + +;; keywords supported: :test :test-not :key :count :start :end :from-end +(ert-deftest cl-seq-nsubstitute-test () + (let ((cl-seq--test-list '(1 2 3 4 5 2 6)) + (orig (copy-sequence cl-seq--test-list)) + (tests '((should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b 2 _list))) + (should (equal _list (cl-substitute 'b 2 _list :start (length _list)))) + (should (equal _list (cl-substitute 'b 2 _list :end 0))) + (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 _list :start 2))) + (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 _list :end 2))) + (should (equal _list (cl-substitute 'b 2 _list :start 2 :end 4))) + (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 _list :count 1))) + (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 _list :count 1 :from-end t))) + (should (equal _list (cl-nsubstitute 'b 2 _list :count -1))) + (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b "2" _list :key #'number-to-string + :test #'string=))) + (should (equal (cl-nsubstitute 'b 2 _list) + (cl-nsubstitute 'b 2 _list :test #'eq))) + (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b 2 _list :test (lambda (a b) (< a b))))) + (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b 2 _list :test (lambda (a b) (>= a b))))) + (should (equal _list (cl-nsubstitute 'b 99 _list :test (lambda (a b) (< a b))))) + (should (equal (cl-nsubstitute 'b 2 _list :test (lambda (a b) (>= a b))) + (cl-nsubstitute 'b 2 _list :test-not (lambda (a b) (< a b))))) + (should (equal '(1 2 b b b 2 b) + (cl-nsubstitute 'b nil _list :if (lambda (x) (> (cl-position x _list) 1))))) + (should (equal '(1 b b b b b b) + (cl-nsubstitute 'b nil _list :if (lambda (x) (> (cl-position x _list :from-end t) 1))))) + (should (equal '(b b 3 4 5 b 6) + (cl-nsubstitute 'b nil _list + :if-not (lambda (x) (> (cl-position x _list) 1))))) + (should (equal '(b 2 3 4 5 2 6) + (cl-nsubstitute 'b nil _list + :if-not (lambda (x) (> (cl-position x _list :from-end t) 1)))))))) + (dolist (test tests) + (let ((_list cl-seq--test-list)) + (cl-seq--with-side-effects orig nil + test))))) + +;; keywords supported: :test :test-not :key :start :end :from-end +(ert-deftest cl-seq-position-test () + (let ((list '(1 2 3 4 5 2 6))) + (should-not (cl-position 'foo list)) + (should (= 1 (cl-position 2 list))) + (should (= 5 (cl-position 2 list :start 5 :end 6))) + (should (= 1 (cl-position 2 list :from-end nil))) + (should (= 5 (cl-position 2 list :from-end t))) + (should (cl-position 2 list :key #'identity + :test (lambda (a b) (eql a b)))) + (should (= 1 (cl-position "2" list :key #'number-to-string :test #'string=))) + (should (= 5 (cl-position "2" list :key #'number-to-string :test #'string= :from-end t))) + (should-not (cl-position "2" list :key #'number-to-string)) + (should (cl-position 5 list :key (lambda (x) (1+ (* 1.0 x x))) :test #'=)) + (should-not (cl-position 5 list :key (lambda (x) (1+ (* 1.0 x x))))) + (should (= 1 (cl-position 5 list :key (lambda (x) (1+ (* x x)))))) + (should (= 5 (cl-position 5 list :key (lambda (x) (1+ (* x x))) :from-end t))))) + +;; keywords supported: :test :test-not :key :start :end +(ert-deftest cl-seq-count-test () + (let ((list '(1 2 3 4 5 2 6))) + (should (= 2 (cl-count 2 list))) + (should (= 1 (cl-count 2 list :start 2))) + (should (= 1 (cl-count 2 list :end 4))) + (should (= 0 (cl-count -5 list))) + (should (= 0 (cl-count 2 list :start 2 :end 4))) + (should (= 4 (cl-count 'foo list :key (lambda (x) (and (cl-evenp x) 'foo))))) + (should (= 4 (cl-count 'foo list :test (lambda (a b) (cl-evenp b))))) + (should (equal (cl-count 'foo list :test (lambda (a b) (cl-oddp b))) + (cl-count 'foo list :test-not (lambda (a b) (cl-evenp b))))))) + +;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end +(ert-deftest cl-seq-mismatch-test () + (let ((list '(1 2 3 4 5 2 6)) + (list2 '(1 999 2 3 4 5 2 6))) + (should-not (cl-mismatch list list)) + (should-not (cl-mismatch list (remove 999 list2))) + (should (= 0 (cl-mismatch list list :key #'number-to-string))) + (should-not (cl-mismatch list list :key #'number-to-string :test #'string=)) + (should (= 1 (cl-mismatch list list2))) + (should (= 0 (cl-mismatch list list2 :from-end t))) + (should (= 3 (cl-mismatch '(1 2 3) list))) + (should-not (cl-mismatch list list2 :end1 1 :end2 1)) + (should-not (cl-mismatch list list2 :start1 1 :start2 2)) + (should (= 1 (cl-mismatch list list2 :start1 1 :end1 2 :start2 4 :end2 4))) + (should (= -1 (cl-mismatch list list2 :key #'number-to-string + :test (lambda (a b) + (and (stringp a) (stringp b))) :from-end t))) + (should (= 7 (cl-mismatch list list2 :key #'number-to-string + :test (lambda (a b) + (and (stringp a) (stringp b)))))))) + +;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end +(ert-deftest cl-seq-search-test () + (let ((list '(1 2 3 4 5 2 6)) + (list2 '(1 999 2 3 4 5 2 6))) + (should-not (cl-search list list2)) + (should (= 2 (cl-search list list2 :start1 1 :start2 2))) + (should (= 4 (cl-search list list2 :start1 3))) + (should (= 6 (cl-search list list2 :start1 5))) + (should (= 0 (cl-search list list2 :end1 1))) + (should (= 0 (cl-search nil list2))) + (should (= 2 (cl-search list list2 :start1 1 :end1 2 :end2 3))) + (should (= 0 (cl-search list list2 :test (lambda (a b) (and (numberp a) (numberp b)))))) + (should (= 0 (cl-search list list2 :key (lambda (x) (and (numberp x) 'foo)) + :test (lambda (a b) (and (eq a 'foo) (eq b 'foo)))))) + (should (= 1 (cl-search (nthcdr 2 list) (nthcdr 2 list2)))) + (should (= 3 (cl-search (nthcdr 2 list) list2))))) + +(ert-deftest cl-seq-test-bug24264 () + "Test for http://debbugs.gnu.org/24264 ." + (let ((list (append (make-list 8000005 1) '(8))) + (list2 (make-list 8000005 2))) + (should (cl-position 8 list)) + (should-not (equal '(8) (last (cl-remove 8 list)))) + (should (equal '(2 8) (last (cl-substitute 2 1 list) 2))) + (should (equal '(2 8) (last (cl-replace list list2) 2))) + (should (equal '(1 1) (last (cl-fill list 1) 2))))) + + +(provide 'cl-seq-tests) +;;; cl-seq-tests.el ends here diff --git a/test/automated/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el index eb26047da2f..eb26047da2f 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el diff --git a/test/automated/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el index 2f8d65e512e..2f8d65e512e 100644 --- a/test/automated/eieio-test-persist.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el diff --git a/test/automated/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index bdf66c946f0..9665beb490e 100644 --- a/test/automated/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -895,6 +895,12 @@ Subclasses to override slot attributes.") (ert-deftest eieio-test-37-obsolete-name-in-constructor () (should (equal (eieio--testing "toto") '("toto" 2)))) +(ert-deftest eieio-autoload () + "Tests to see whether reftex-auc has been autoloaded" + (should + (fboundp 'eieio--defalias))) + + (provide 'eieio-tests) ;;; eieio-tests.el ends here diff --git a/test/automated/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 5d3675553d7..83fddd15165 100644 --- a/test/automated/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -344,53 +344,35 @@ This macro is used to test if macroexpansion in `should' works." ((error) (should (equal actual-condition expected-condition))))))) +(defun ert-test--which-file () + "Dummy function to help test `symbol-file' for tests.") + (ert-deftest ert-test-deftest () - ;; FIXME: These tests don't look very good. What is their intent, i.e. what - ;; are they really testing? The precise generated code shouldn't matter, so - ;; we should either test the behavior of the code, or else try to express the - ;; kind of efficiency guarantees we're looking for. - (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) - '(progn - (ert-set-test 'abc - (progn - "Constructor for objects of type `ert-test'." - (vector 'cl-struct-ert-test 'abc "foo" - #'(lambda nil) - nil ':passed - '(bar)))) - (setq current-load-list - (cons - '(ert-deftest . abc) - current-load-list)) - 'abc))) - (should (equal (macroexpand '(ert-deftest def () - :expected-result ':passed)) - '(progn - (ert-set-test 'def - (progn - "Constructor for objects of type `ert-test'." - (vector 'cl-struct-ert-test 'def nil - #'(lambda nil) - nil ':passed 'nil))) - (setq current-load-list - (cons - '(ert-deftest . def) - current-load-list)) - 'def))) + (ert-deftest ert-test-abc () "foo" :tags '(bar)) + (let ((abc (ert-get-test 'ert-test-abc))) + (should (equal (ert-test-tags abc) '(bar))) + (should (equal (ert-test-documentation abc) "foo"))) + (should (equal (symbol-file 'ert-test-deftest 'ert-deftest) + (symbol-file 'ert-test--which-file 'defun))) + + (ert-deftest ert-test-def () :expected-result ':passed) + (let ((def (ert-get-test 'ert-test-def))) + (should (equal (ert-test-expected-result-type def) :passed))) ;; :documentation keyword is forbidden (should-error (macroexpand '(ert-deftest ghi () :documentation "foo")))) (ert-deftest ert-test-record-backtrace () - (let ((test (make-ert-test :body (lambda () (ert-fail "foo"))))) - (let ((result (ert-run-test test))) - (should (ert-test-failed-p result)) - (with-temp-buffer - (ert--print-backtrace (ert-test-failed-backtrace result)) - (goto-char (point-min)) - (end-of-line) - (let ((first-line (buffer-substring-no-properties (point-min) (point)))) - (should (equal first-line " (closure (ert--test-body-was-run t) nil (ert-fail \"foo\"))()"))))))) + (let* ((test-body (lambda () (ert-fail "foo"))) + (test (make-ert-test :body test-body)) + (result (ert-run-test test))) + (should (ert-test-failed-p result)) + (with-temp-buffer + (ert--print-backtrace (ert-test-failed-backtrace result)) + (goto-char (point-min)) + (end-of-line) + (let ((first-line (buffer-substring-no-properties (point-min) (point)))) + (should (equal first-line (format " %S()" test-body))))))) (ert-deftest ert-test-messages () :tags '(:causes-redisplay) @@ -837,7 +819,3 @@ This macro is used to test if macroexpansion in `should' works." (provide 'ert-tests) ;;; ert-tests.el ends here - -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/test/automated/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index ef8642aebfb..ef8642aebfb 100644 --- a/test/automated/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el diff --git a/test/automated/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el index 8ed0f2a240d..8ed0f2a240d 100644 --- a/test/automated/generator-tests.el +++ b/test/lisp/emacs-lisp/generator-tests.el diff --git a/test/automated/let-alist.el b/test/lisp/emacs-lisp/let-alist-tests.el index 80d418cabbe..657a27a67dc 100644 --- a/test/automated/let-alist.el +++ b/test/lisp/emacs-lisp/let-alist-tests.el @@ -88,4 +88,12 @@ '(cdr (assq 'baz (cdr (assq 'bar (cdr (assq 'foo var)))))))) (should (equal (let-alist--access-sexp '..foo.bar.baz 'var) '.foo.bar.baz))) +(ert-deftest let-alist--deep-dot-search--nested () + "Check that nested `let-alist' forms don't generate spurious bindings. +See Bug#24641." + (should (equal (let-alist--deep-dot-search '(foo .bar (baz .qux))) + '((.bar . bar) (.qux . qux)))) + (should (equal (let-alist--deep-dot-search '(foo .bar (let-alist .qux .baz))) + '((.bar . bar) (.qux . qux))))) ; no .baz + ;;; let-alist.el ends here diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el new file mode 100644 index 00000000000..2dadae95536 --- /dev/null +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -0,0 +1,307 @@ +;;; lisp-tests.el --- Test Lisp editing commands -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. + +;; Author: Aaron S. Hawley <aaron.s.hawley@gmail.com> +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Author: Daniel Colascione <dancol@dancol.org> +;; Keywords: internal + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Testing of `forward-sexp' and related functions. + +;;; Code: + +(require 'ert) +(require 'python) +(require 'cl-lib) + +(ert-deftest lisp-forward-sexp-1-empty-parens () + "Test basics of \\[forward-sexp]." + (with-temp-buffer + (insert "()") + (goto-char (point-min)) + (should (null + (forward-sexp 1))))) + +(ert-deftest lisp-forward-sexp-1-error-mismatch () + "Test basics of \\[forward-sexp]." + (with-temp-buffer + (insert "(") + (goto-char (point-min)) + (should-error + (forward-sexp 1)))) + +(ert-deftest lisp-backward-sexp-1-empty-parens () + "Test basics of \\[backward-sexp]." + (with-temp-buffer + (insert "()") + (should (null + (forward-sexp -1))))) + +(ert-deftest lisp-backward-sexp-1-error-mismatch () + "Test mismatched parens with \\[backward-sexp]." + (with-temp-buffer + (insert "(") + (should-error + (forward-sexp -1)))) + +(ert-deftest lisp-forward-sexp-1-eobp () + "Test \\[forward-sexp] at `eobp'." + (with-temp-buffer + (insert "()") + (should (null ;; (should-error ;; No, per #13994 + (forward-sexp 1))))) + +(ert-deftest lisp-backward-sexp-1-eobp () + "Test \\[backward-sexp] at `bobp'." + (with-temp-buffer + (insert "()") + (goto-char (point-min)) + (should (null ;; (should-error ;; No, per #13994 + (forward-sexp -1))))) + +(ert-deftest lisp-forward-sexp-2-eobp () + "Test \\[forward-sexp] beyond `eobp'." + (with-temp-buffer + (insert "()") + (goto-char (point-min)) + (should (null ;; (should-error ;; No, per #13994 + (forward-sexp 2))) + (should (eobp)))) + +(ert-deftest lisp-backward-sexp-2-bobp () + "Test \\[backward-sexp] beyond `bobp'." + (with-temp-buffer + (insert "()") + (should (null ;; (should-error ;; No, per #13994 + (forward-sexp -2))) + (should (bobp)))) + +(ert-deftest lisp-forward-sexp-2-eobp-and-subsequent () + "Test \\[forward-sexp] beyond `eobp' and again." + (with-temp-buffer + (insert "()") + (goto-char (point-min)) + (should (null ;; (should-error ;; No, per #13994 + (forward-sexp 2))) + (should (eobp)) + (should (null ;; (should-error ;; No, per #13994 + (forward-sexp 1))))) + +(ert-deftest lisp-backward-sexp-2-bobp-and-subsequent () + "Test \\[backward-sexp] ahead of `bobp' and again." + (with-temp-buffer + (insert "()") + (should (null ;; (should-error ;; No, per #13994 + (forward-sexp -2))) + (should (bobp)) + (should (null ;; (should-error ;; No, per #13994 + (forward-sexp -1))))) + +(ert-deftest lisp-delete-pair-parens () + "Test \\[delete-pair] with parens." + (with-temp-buffer + (insert "(foo)") + (goto-char (point-min)) + (delete-pair) + (should (string-equal "foo" (buffer-string))))) + +(ert-deftest lisp-delete-pair-quotation-marks () + "Test \\[delete-pair] with quotation marks." + (with-temp-buffer + (insert "\"foo\"") + (goto-char (point-min)) + (delete-pair) + (should (string-equal "foo" (buffer-string))))) + +(ert-deftest lisp-delete-pair-quotes-in-text-mode () + "Test \\[delete-pair] against string in Text Mode for #15014." + (with-temp-buffer + (text-mode) + (insert "\"foo\"") + (goto-char (point-min)) + (delete-pair) + (should (string-equal "fo\"" (buffer-string))))) + +(ert-deftest lisp-delete-pair-quotes-text-mode-syntax-table () + "Test \\[delete-pair] with modified Text Mode syntax for #15014." + (with-temp-buffer + (text-mode) + (let ((st (copy-syntax-table text-mode-syntax-table))) + (with-syntax-table st + ;; (modify-syntax-entry ?\" "." text-mode-syntax-table) + (modify-syntax-entry ?\" "$" st) + (insert "\"foo\"") + (goto-char (point-min)) + (delete-pair) + (should (string-equal "foo" (buffer-string))))))) + +(ert-deftest lisp-forward-sexp-elisp-inside-symbol () + "Test \\[forward-sexp] on symbol in Emacs Lisp Mode for #20492." + (with-temp-buffer + (emacs-lisp-mode) + (insert "hide-ifdef-env ") + (insert (concat (number-sequence 32 126))) + (goto-char (point-min)) + (re-search-forward "hide" nil t) ;; (forward-char 4) + (should (looking-at "-")) + (forward-sexp) + (should (looking-at " ")))) + +(ert-deftest lisp-forward-sexp-elisp-quoted-symbol () + "Test \\[forward-sexp] on symbol in Emacs Lisp Mode for #20492." + (with-temp-buffer + (emacs-lisp-mode) + (insert "`hide-ifdef-env'.") + (goto-char (point-min)) + (re-search-forward "hide" nil t) ;; (forward-char 5) + (should (= ?- (char-after))) + (forward-sexp) + (should (= ?. (char-before))))) + +(ert-deftest lisp-forward-sexp-python-triple-quoted-string () + "Test \\[forward-sexp] on Python doc strings for #11321." + (with-temp-buffer + (insert "\"\"\"Triple-quoted string\"\"\"") + (goto-char (point-min)) + (let ((python-indent-guess-indent-offset nil)) + (python-mode)) + (forward-sexp) + (should (eobp)))) + +(ert-deftest lisp-forward-sexp-python-triple-quotes-string () + "Test \\[forward-sexp] on Python doc strings for #11321." + (with-temp-buffer + (insert "'''Triple-quoted string'''") + (goto-char (point-min)) + (let ((python-indent-guess-indent-offset nil)) + (python-mode)) + (forward-sexp) + (should (eobp)))) + +(ert-deftest lisp-forward-sexp-emacs-lisp-semi-char-error () + "Test \\[forward-sexp] on expression with unquoted semicolon per #4030." + (with-temp-buffer + (emacs-lisp-mode) + (insert "(insert ?;)") + (goto-char (point-min)) + (should-error (forward-sexp)))) ;; FIXME: Shouldn't be an error. + +(ert-deftest lisp-forward-sexp-emacs-lisp-quote-char () + "Test \\[forward-sexp] on expression with unquoted quote per #4030." + (with-temp-buffer + (emacs-lisp-mode) + (insert "(insert ?\")") + (goto-char (point-min)) + (should-error (forward-sexp)))) ;; FIXME: Shouldn't be an error. + +;; Test some core Elisp rules. +(ert-deftest core-elisp-tests-1-defvar-in-let () + "Test some core Elisp rules." + (with-temp-buffer + ;; Check that when defvar is run within a let-binding, the toplevel default + ;; is properly initialized. + (should (equal (list (let ((c-e-x 1)) (defvar c-e-x 2) c-e-x) c-e-x) + '(1 2))) + (should (equal (list (let ((c-e-x 1)) + (defcustom c-e-x 2 "doc" :group 'blah :type 'integer) c-e-x) + c-e-x) + '(1 2))))) + +(ert-deftest core-elisp-tests-2-window-configurations () + "Test properties of window-configurations." + (let ((wc (current-window-configuration))) + (with-current-buffer (window-buffer (frame-selected-window)) + (push-mark) + (activate-mark)) + (set-window-configuration wc) + (should (or (not mark-active) (mark))))) + +(ert-deftest core-elisp-tests-3-backquote () + (should (eq 3 (eval ``,,'(+ 1 2))))) + +;; Test up-list and backward-up-list. +(defun lisp-run-up-list-test (fn data start instructions) + (cl-labels ((posof (thing) + (and (symbolp thing) + (= (length (symbol-name thing)) 1) + (- (aref (symbol-name thing) 0) ?a -1)))) + (with-temp-buffer + (set-syntax-table (make-syntax-table)) + ;; Use a syntax table in which single quote is a string + ;; character so that we can embed the test data in a lisp string + ;; literal. + (modify-syntax-entry ?\' "\"") + (insert data) + (goto-char (posof start)) + (dolist (instruction instructions) + (cond ((posof instruction) + (funcall fn) + (should (eql (point) (posof instruction)))) + ((symbolp instruction) + (should-error (funcall fn) + :type instruction)) + (t (cl-assert nil nil "unknown ins"))))))) + +(defmacro define-lisp-up-list-test (name fn data start &rest expected) + `(ert-deftest ,name () + (lisp-run-up-list-test ,fn ,data ',start ',expected))) + +(define-lisp-up-list-test up-list-basic + (lambda () (up-list)) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i k v scan-error) + +(define-lisp-up-list-test up-list-with-forward-sexp-function + (lambda () + (let ((forward-sexp-function + (lambda (&optional arg) + (let ((forward-sexp-function nil)) + (forward-sexp arg))))) + (up-list))) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i k v scan-error) + +(define-lisp-up-list-test up-list-out-of-string + (lambda () (up-list 1 t)) + (or "1 (1 '2 2 (2 2 2' 1) 1") + ;; abcdefghijklmnopqrstuvwxy + o r u scan-error) + +(define-lisp-up-list-test up-list-cross-string + (lambda () (up-list 1 t)) + (or "(1 '2 ( 2' 1 '2 ) 2' 1)") + ;; abcdefghijklmnopqrstuvwxy + i r u x scan-error) + +(define-lisp-up-list-test up-list-no-cross-string + (lambda () (up-list 1 t t)) + (or "(1 '2 ( 2' 1 '2 ) 2' 1)") + ;; abcdefghijklmnopqrstuvwxy + i k x scan-error) + +(define-lisp-up-list-test backward-up-list-basic + (lambda () (backward-up-list)) + (or "(1 1 (1 1) 1 (1 1) 1)") + ;; abcdefghijklmnopqrstuv + i f a scan-error) + +(provide 'lisp-tests) +;;; lisp-tests.el ends here diff --git a/test/automated/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 20cb0f6b399..0af1c656e09 100644 --- a/test/automated/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -192,6 +192,14 @@ Evaluate BODY for each created map. (2 . b) (3 . c)))))) +(ert-deftest test-map-do () + (with-maps-do map + (let ((result nil)) + (map-do (lambda (k v) + (add-to-list 'result (list (int-to-string k) v))) + map) + (should (equal result '(("2" 5) ("1" 4) ("0" 3))))))) + (ert-deftest test-map-keys-apply () (with-maps-do map (should (equal (map-keys-apply (lambda (k) (int-to-string k)) diff --git a/test/automated/advice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el index cd51599b86a..cd51599b86a 100644 --- a/test/automated/advice-tests.el +++ b/test/lisp/emacs-lisp/nadvice-tests.el diff --git a/test/automated/data/package/archive-contents b/test/lisp/emacs-lisp/package-resources/archive-contents index e2f92304f86..e2f92304f86 100644 --- a/test/automated/data/package/archive-contents +++ b/test/lisp/emacs-lisp/package-resources/archive-contents diff --git a/test/automated/data/package/key.pub b/test/lisp/emacs-lisp/package-resources/key.pub index a326d34e54f..a326d34e54f 100644 --- a/test/automated/data/package/key.pub +++ b/test/lisp/emacs-lisp/package-resources/key.pub diff --git a/test/automated/data/package/key.sec b/test/lisp/emacs-lisp/package-resources/key.sec index d21e6ae9a45..d21e6ae9a45 100644 --- a/test/automated/data/package/key.sec +++ b/test/lisp/emacs-lisp/package-resources/key.sec diff --git a/test/automated/data/package/macro-problem-package-1.0/macro-aux.el b/test/lisp/emacs-lisp/package-resources/macro-problem-package-1.0/macro-aux.el index f43232224af..f43232224af 100644 --- a/test/automated/data/package/macro-problem-package-1.0/macro-aux.el +++ b/test/lisp/emacs-lisp/package-resources/macro-problem-package-1.0/macro-aux.el diff --git a/test/automated/data/package/macro-problem-package-1.0/macro-problem.el b/test/lisp/emacs-lisp/package-resources/macro-problem-package-1.0/macro-problem.el index 0533b1bd9c4..0533b1bd9c4 100644 --- a/test/automated/data/package/macro-problem-package-1.0/macro-problem.el +++ b/test/lisp/emacs-lisp/package-resources/macro-problem-package-1.0/macro-problem.el diff --git a/test/automated/data/package/macro-problem-package-2.0/macro-aux.el b/test/lisp/emacs-lisp/package-resources/macro-problem-package-2.0/macro-aux.el index 6a55a40e3b4..6a55a40e3b4 100644 --- a/test/automated/data/package/macro-problem-package-2.0/macro-aux.el +++ b/test/lisp/emacs-lisp/package-resources/macro-problem-package-2.0/macro-aux.el diff --git a/test/automated/data/package/macro-problem-package-2.0/macro-problem.el b/test/lisp/emacs-lisp/package-resources/macro-problem-package-2.0/macro-problem.el index cad4ed93f19..cad4ed93f19 100644 --- a/test/automated/data/package/macro-problem-package-2.0/macro-problem.el +++ b/test/lisp/emacs-lisp/package-resources/macro-problem-package-2.0/macro-problem.el diff --git a/test/automated/data/package/multi-file-0.2.3.tar b/test/lisp/emacs-lisp/package-resources/multi-file-0.2.3.tar Binary files differindex 2f1c5e93df1..2f1c5e93df1 100644 --- a/test/automated/data/package/multi-file-0.2.3.tar +++ b/test/lisp/emacs-lisp/package-resources/multi-file-0.2.3.tar diff --git a/test/automated/data/package/multi-file-readme.txt b/test/lisp/emacs-lisp/package-resources/multi-file-readme.txt index affd2e96fb0..affd2e96fb0 100644 --- a/test/automated/data/package/multi-file-readme.txt +++ b/test/lisp/emacs-lisp/package-resources/multi-file-readme.txt diff --git a/test/automated/data/package/newer-versions/archive-contents b/test/lisp/emacs-lisp/package-resources/newer-versions/archive-contents index add5f2909d0..add5f2909d0 100644 --- a/test/automated/data/package/newer-versions/archive-contents +++ b/test/lisp/emacs-lisp/package-resources/newer-versions/archive-contents diff --git a/test/automated/data/package/newer-versions/new-pkg-1.0.el b/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el index 7251622fa59..7251622fa59 100644 --- a/test/automated/data/package/newer-versions/new-pkg-1.0.el +++ b/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el diff --git a/test/automated/data/package/newer-versions/simple-single-1.4.el b/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el index 7b1c00c06db..7b1c00c06db 100644 --- a/test/automated/data/package/newer-versions/simple-single-1.4.el +++ b/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el diff --git a/test/automated/data/package/package-test-server.py b/test/lisp/emacs-lisp/package-resources/package-test-server.py index 35ca820f31f..1acd9f744b9 100644 --- a/test/automated/data/package/package-test-server.py +++ b/test/lisp/emacs-lisp/package-resources/package-test-server.py @@ -10,7 +10,7 @@ Protocol = "HTTP/1.0" if sys.argv[1:]: port = int(sys.argv[1]) else: - port = 8000 + port = 0 server_address = ('127.0.0.1', port) HandlerClass.protocol_version = Protocol diff --git a/test/automated/data/package/signed/archive-contents b/test/lisp/emacs-lisp/package-resources/signed/archive-contents index 2a773ecba6a..2a773ecba6a 100644 --- a/test/automated/data/package/signed/archive-contents +++ b/test/lisp/emacs-lisp/package-resources/signed/archive-contents diff --git a/test/automated/data/package/signed/archive-contents.sig b/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig Binary files differindex 658edd3f60e..658edd3f60e 100644 --- a/test/automated/data/package/signed/archive-contents.sig +++ b/test/lisp/emacs-lisp/package-resources/signed/archive-contents.sig diff --git a/test/automated/data/package/signed/signed-bad-1.0.el b/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el index 3734823876e..3734823876e 100644 --- a/test/automated/data/package/signed/signed-bad-1.0.el +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el diff --git a/test/automated/data/package/signed/signed-bad-1.0.el.sig b/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el.sig Binary files differindex 747918794ca..747918794ca 100644 --- a/test/automated/data/package/signed/signed-bad-1.0.el.sig +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-bad-1.0.el.sig diff --git a/test/automated/data/package/signed/signed-good-1.0.el b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el index 22718df2763..22718df2763 100644 --- a/test/automated/data/package/signed/signed-good-1.0.el +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el diff --git a/test/automated/data/package/signed/signed-good-1.0.el.sig b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig Binary files differindex 747918794ca..747918794ca 100644 --- a/test/automated/data/package/signed/signed-good-1.0.el.sig +++ b/test/lisp/emacs-lisp/package-resources/signed/signed-good-1.0.el.sig diff --git a/test/automated/data/package/simple-depend-1.0.el b/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el index b58b658d024..b58b658d024 100644 --- a/test/automated/data/package/simple-depend-1.0.el +++ b/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el diff --git a/test/automated/data/package/simple-single-1.3.el b/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el index 6756a28080b..6756a28080b 100644 --- a/test/automated/data/package/simple-single-1.3.el +++ b/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el diff --git a/test/automated/data/package/simple-single-readme.txt b/test/lisp/emacs-lisp/package-resources/simple-single-readme.txt index 25d3034032b..25d3034032b 100644 --- a/test/automated/data/package/simple-single-readme.txt +++ b/test/lisp/emacs-lisp/package-resources/simple-single-readme.txt diff --git a/test/automated/data/package/simple-two-depend-1.1.el b/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el index 9cfe5c0d4e2..9cfe5c0d4e2 100644 --- a/test/automated/data/package/simple-two-depend-1.1.el +++ b/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el diff --git a/test/automated/package-test.el b/test/lisp/emacs-lisp/package-tests.el index c4c856f3031..3d2801e3d70 100644 --- a/test/automated/package-test.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -97,7 +97,7 @@ (multi-file (0 1)))) "`package-desc' used for testing dependencies.") -(defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir) +(defvar package-test-data-dir (expand-file-name "package-resources" package-test-file-dir) "Base directory of package test files.") (defvar package-test-fake-contents-file @@ -190,18 +190,18 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-desc-from-buffer () "Parse an elisp buffer to get a `package-desc' object." - (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") + (with-package-test (:basedir "package-resources" :file "simple-single-1.3.el") (should (equal (package-buffer-info) simple-single-desc))) - (with-package-test (:basedir "data/package" :file "simple-depend-1.0.el") + (with-package-test (:basedir "package-resources" :file "simple-depend-1.0.el") (should (equal (package-buffer-info) simple-depend-desc))) - (with-package-test (:basedir "data/package" + (with-package-test (:basedir "package-resources" :file "multi-file-0.2.3.tar") (tar-mode) (should (equal (package-tar-file-info) multi-file-desc)))) (ert-deftest package-test-install-single () "Install a single file without using an archive." - (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") + (with-package-test (:basedir "package-resources" :file "simple-single-1.3.el") (should (package-install-from-buffer)) (package-initialize) (should (package-installed-p 'simple-single)) @@ -244,7 +244,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-macro-compilation () "Install a package which includes a dependency." - (with-package-test (:basedir "data/package") + (with-package-test (:basedir "package-resources") (package-install-file (expand-file-name "macro-problem-package-1.0/")) (require 'macro-problem) ;; `macro-problem-func' uses a macro from `macro-aux'. @@ -283,7 +283,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-install-prioritized () "Install a lower version from a higher-prioritized archive." (with-package-test () - (let* ((newer-version (expand-file-name "data/package/newer-versions" + (let* ((newer-version (expand-file-name "package-resources/newer-versions" package-test-file-dir)) (package-archives `(("older" . ,package-test-data-dir) ("newer" . ,newer-version))) @@ -299,7 +299,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-install-multifile () "Check properties of the installed multi-file package." - (with-package-test (:basedir "data/package" :install '(multi-file)) + (with-package-test (:basedir "package-resources" :install '(multi-file)) (let ((autoload-file (expand-file-name "multi-file-autoloads.el" (expand-file-name @@ -350,7 +350,7 @@ Must called from within a `tar-mode' buffer." (package-menu-execute) (should (package-installed-p 'simple-single)) (let ((package-test-data-dir - (expand-file-name "data/package/newer-versions" package-test-file-dir))) + (expand-file-name "package-resources/newer-versions" package-test-file-dir))) (setq package-archives `(("gnu" . ,package-test-data-dir))) (package-menu-refresh) @@ -370,18 +370,28 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-test-update-archives-async () "Test updating package archives asynchronously." (skip-unless (executable-find "python2")) - ;; For some reason this test doesn't work reliably on hydra.nixos.org. - (skip-unless (not (getenv "NIX_STORE"))) - (with-package-test (:basedir - package-test-data-dir - :location "http://0.0.0.0:8000/") - (let* ((package-menu-async t) - (process (start-process - "package-server" "package-server-buffer" - (executable-find "python2") - (expand-file-name "package-test-server.py")))) - (unwind-protect - (progn + (let* ((package-menu-async t) + (default-directory package-test-data-dir) + (process (start-process + "package-server" "package-server-buffer" + (executable-find "python2") + "package-test-server.py")) + port) + (unwind-protect + (progn + (with-current-buffer "package-server-buffer" + (should + (with-timeout (10 nil) + (while (not port) + (accept-process-output nil 1) + (goto-char (point-min)) + (if (re-search-forward "Serving HTTP on .* port \\([0-9]+\\) " + nil t) + (setq port (match-string 1)))) + port))) + (with-package-test (:basedir + package-test-data-dir + :location (format "http://0.0.0.0:%s/" port)) (list-packages) (should package--downloads-in-progress) (should mode-line-process) @@ -395,8 +405,8 @@ Must called from within a `tar-mode' buffer." (skip-unless (process-live-p process)) (goto-char (point-min)) (should - (search-forward-regexp "^ +simple-single" nil t))) - (if (process-live-p process) (kill-process process)))))) + (search-forward-regexp "^ +simple-single" nil t)))) + (if (process-live-p process) (kill-process process))))) (ert-deftest package-test-describe-package () "Test displaying help for a package." @@ -470,7 +480,7 @@ Must called from within a `tar-mode' buffer." (delete-directory homedir t))))) (let* ((keyring (expand-file-name "key.pub" package-test-data-dir)) (package-test-data-dir - (expand-file-name "data/package/signed" package-test-file-dir))) + (expand-file-name "package-resources/signed" package-test-file-dir))) (with-package-test () (package-initialize) (package-import-keyring keyring) @@ -529,7 +539,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-x-test-upload-buffer () "Test creating an \"archive-contents\" file" - (with-package-test (:basedir "data/package" + (with-package-test (:basedir "package-resources" :file "simple-single-1.3.el" :upload-base t) (package-upload-buffer) @@ -553,7 +563,7 @@ Must called from within a `tar-mode' buffer." (ert-deftest package-x-test-upload-new-version () "Test uploading a new version of a package" - (with-package-test (:basedir "data/package" + (with-package-test (:basedir "package-resources" :file "simple-single-1.3.el" :upload-base t) (package-upload-buffer) @@ -620,6 +630,7 @@ Must called from within a `tar-mode' buffer." simple-depend-desc-2))) (should (equal (package--sort-by-dependence delete-list) + (list simple-depend-desc-2 simple-depend-desc-1 new-pkg-desc multi-file-desc simple-depend-desc simple-single-desc))) (should diff --git a/test/automated/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index a428e4092f1..a428e4092f1 100644 --- a/test/automated/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el diff --git a/test/automated/regexp-tests.el b/test/lisp/emacs-lisp/regexp-opt-tests.el index 01119a3374f..01119a3374f 100644 --- a/test/automated/regexp-tests.el +++ b/test/lisp/emacs-lisp/regexp-opt-tests.el diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el new file mode 100644 index 00000000000..affde8914bd --- /dev/null +++ b/test/lisp/emacs-lisp/ring-tests.el @@ -0,0 +1,206 @@ +;;; ring-tests.el --- Tests for ring.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'ring) + +(ert-deftest ring-tests-make-ring-ring-p () + (should (ring-p (make-ring 5)))) + +(ert-deftest ring-tests-insert-at-beginning () + (let ((ring (make-ring 5))) + (ring-insert-at-beginning ring 'foo) + (ring-insert-at-beginning ring 'bar) + (should (equal (ring-elements ring) '(foo bar))))) + +(ert-deftest ring-tests-plus1 () + (should (= (ring-plus1 0 5) 1)) + (should (= (ring-plus1 4 5) 0))) + +(ert-deftest ring-tests-minus1 () + (should (= (ring-minus1 0 5) 4)) + (should (= (ring-minus1 4 5) 3))) + +(ert-deftest ring-tests-length () + (let ((ring (make-ring 2))) + (should (= (ring-length ring) 0)) + (ring-insert ring 'a) + (should (= (ring-length ring) 1)) + (ring-insert ring 'b) + (should (= (ring-length ring) 2)) + (ring-insert ring 'c) + (should (= (ring-length ring) 2)))) + +(ert-deftest ring-tests-index () + (should (= (ring-index 0 0 3 3) 2)) + (should (= (ring-index 0 0 3 5) 2)) + (should (= (ring-index 0 2 3 3) 1)) + (should (= (ring-index 1 2 3 3) 0)) + (should (= (ring-index 2 2 3 3) 2))) + +(ert-deftest ring-tests-empty-p () + (let ((ring (make-ring 5))) + (should (ring-empty-p ring)) + (ring-insert ring 1) + (should-not (ring-empty-p ring)) + (ring-remove ring) + (should (ring-empty-p ring)))) + +(ert-deftest ring-tests-size () + (let ((ring (make-ring 2))) + (should (= (ring-size ring) 2)) + (ring-insert ring "a") + (ring-insert ring "b") + (ring-insert ring "c") + (should (= (ring-size ring) 2)) + (ring-extend ring 3) + (should (= (ring-size ring) 5)))) + +(ert-deftest ring-tests-copy () + (let ((ring1 (make-ring 3))) + (ring-insert ring1 1) + (ring-insert ring1 2) + (let ((ring2 (ring-copy ring1))) + (should-not (eq ring1 ring2)) + (should (= (ring-size ring1) (ring-size ring2))) + (should (equal (ring-elements ring1) (ring-elements ring2)))))) + +(ert-deftest ring-tests-insert () + (let ((ring (make-ring 2))) + (ring-insert ring :a) + (should (equal (ring-elements ring) '(:a))) + (ring-insert ring :b) + (should (equal (ring-elements ring) '(:b :a))) + (ring-insert ring :c) + (should (equal (ring-elements ring) '(:c :b))))) + +(ert-deftest ring-tests-remove () + (let ((ring (make-ring 2))) + (should-error (ring-remove ring)) + (ring-insert ring 'foo) + (ring-insert ring 'bar) + (should (eq (ring-remove ring) 'foo)) + (should (equal (ring-elements ring) '(bar))) + (ring-insert ring 'baz) + (should (eq (ring-remove ring 0) 'baz)) + (should (equal (ring-elements ring) '(bar))))) + +(ert-deftest ring-tests-ref () + (let ((ring (make-ring 2))) + (should-error (ring-ref ring 0)) + (ring-insert ring :a) + (should (eq (ring-ref ring 0) :a)) + (ring-insert ring :b) + (should (eq (ring-ref ring 0) :b)) + (should (eq (ring-ref ring 1) :a)) + (should (eq (ring-ref ring 2) :b)))) + +(ert-deftest ring-tests-elements () + (let ((ring (make-ring 5))) + (ring-insert ring 3) + (ring-insert ring 2) + (ring-insert ring 1) + (should (equal (ring-elements ring) '(1 2 3))))) + +(ert-deftest ring-tests-member () + (let ((ring (make-ring 3))) + (ring-insert ring "foo") + (ring-insert ring "bar") + (should (= (ring-member ring "foo") 1)) + (should (= (ring-member ring "bar") 0)) + (should-not (ring-member ring "baz")))) + +(ert-deftest ring-tests-next () + (let ((ring (make-ring 3))) + (ring-insert ring 'a) + (ring-insert ring 'b) + (should (eq (ring-next ring 'b) 'a)) + (should (eq (ring-next ring 'a) 'b)) + (should-error (ring-next ring 'c)))) + +(ert-deftest ring-tests-previous () + (let ((ring (make-ring 3))) + (ring-insert ring 'a) + (ring-insert ring 'b) + (should (eq (ring-previous ring 'b) 'a)) + (should (eq (ring-previous ring 'a) 'b)) + (should-error (ring-previous ring 'c)))) + +(ert-deftest ring-tests-extend () + (let ((ring (make-ring 2))) + (ring-insert ring 1) + (ring-insert ring 2) + (should (= (ring-size ring) 2)) + (should (= (ring-length ring) 2)) + (ring-extend ring 3) + (ring-insert ring 3) + (should (= (ring-size ring) 5)) + (should (equal (ring-elements ring) '(3 2 1))))) + +(ert-deftest ring-tests-insert () + (let ((ring (make-ring 2))) + (ring-insert+extend ring :a) + (ring-insert+extend ring :b) + (should (equal (ring-elements ring) '(:b :a))) + (ring-insert+extend ring :c) + (should (equal (ring-elements ring) '(:c :b))) + (ring-insert+extend ring :d t) + (should (equal (ring-elements ring) '(:d :c :b))))) + +(ert-deftest ring-tests-remove+insert+extend () + (let ((ring (make-ring 3))) + (ring-insert ring 1) + (ring-insert ring 1) + (ring-insert ring 2) + (ring-remove+insert+extend ring 1) + (should (equal (ring-elements ring) '(1 2))) + (ring-remove+insert+extend ring 0) + (should (equal (ring-elements ring) '(0 1 2))) + (ring-remove+insert+extend ring 3) + (should (equal (ring-elements ring) '(3 0 1))) + (ring-remove+insert+extend ring 4 t) + (should (equal (ring-elements ring) '(4 3 0 1))) + (ring-remove+insert+extend ring 1 t) + (should (equal (ring-elements ring) '(1 4 3 0))))) + +(ert-deftest ring-tests-convert-sequence-to-ring () + (let ((ring (ring-convert-sequence-to-ring '(a b c)))) + (should (equal (ring-elements ring) '(a b c)))) + (let ((ring (ring-convert-sequence-to-ring [1 2 3]))) + (should (equal (ring-elements ring) '(1 2 3)))) + (let ((ring (ring-convert-sequence-to-ring "abc"))) + (should (equal (ring-elements ring) '(?a ?b ?c)))) + (let ((ring (make-ring 2))) + (ring-insert ring :a) + (ring-insert ring :b) + (should + (equal (ring-elements (ring-convert-sequence-to-ring ring)) + (ring-elements ring))))) + +(provide 'ring-tests) +;;; ring-tests.el ends here diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el new file mode 100644 index 00000000000..7ff45f650cb --- /dev/null +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -0,0 +1,37 @@ +;;; rx-tests.el --- test for rx.el functions -*- lexical-binding: t -*- + +;; Copyright (C) 2016 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +(require 'ert) +(require 'rx) + +;;; Code: + +(ert-deftest rx-char-any () + "Test character alternatives with `\]' and `-' (Bug#25123)." + (should (string-match + (rx string-start (1+ (char (?\] . ?\{) (?< . ?\]) (?- . ?:))) + string-end) + (apply #'string (nconc (number-sequence ?\] ?\{) + (number-sequence ?< ?\]) + (number-sequence ?- ?:)))))) + +(provide 'rx-tests) +;; rx-tests.el ends here. diff --git a/test/automated/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index a8ca48b1328..a7a43471de3 100644 --- a/test/automated/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -97,6 +97,31 @@ Evaluate BODY for each created sequence. (with-test-sequences (seq '()) (should (seq-empty-p (seq-take-while #'test-sequences-oddp seq))))) +(ert-deftest test-seq-map-indexed () + (should (equal (seq-map-indexed (lambda (elt i) + (list elt i)) + nil) + nil)) + (should (equal (seq-map-indexed (lambda (elt i) + (list elt i)) + '(a b c d)) + '((a 0) (b 1) (c 2) (d 3))))) + +(ert-deftest test-seq-do-indexed () + (let ((result nil)) + (seq-do-indexed (lambda (elt i) + (add-to-list 'result (list elt i))) + nil) + (should (equal result nil))) + (with-test-sequences (seq '(4 5 6)) + (let ((result nil)) + (seq-do-indexed (lambda (elt i) + (add-to-list 'result (list elt i))) + seq) + (should (equal (seq-elt result 0) '(6 2))) + (should (equal (seq-elt result 1) '(5 1))) + (should (equal (seq-elt result 2) '(4 0)))))) + (ert-deftest test-seq-filter () (with-test-sequences (seq '(6 7 8 9 10)) (should (equal (seq-filter #'test-sequences-evenp seq) '(6 8 10))) @@ -156,6 +181,10 @@ Evaluate BODY for each created sequence. (should-not (seq-contains seq 3)) (should-not (seq-contains seq nil)))) +(ert-deftest test-seq-contains-should-return-the-elt () + (with-test-sequences (seq '(3 4 5 6)) + (should (= 5 (seq-contains seq 5))))) + (ert-deftest test-seq-every-p () (with-test-sequences (seq '(43 54 22 1)) (should (seq-every-p (lambda (elt) t) seq)) @@ -337,5 +366,38 @@ Evaluate BODY for each created sequence. (should (= (seq-position seq 'a #'eq) 0)) (should (null (seq-position seq (make-symbol "a") #'eq))))) +(ert-deftest test-seq-sort-by () + (let ((seq ["x" "xx" "xxx"])) + (should (equal (seq-sort-by #'seq-length #'> seq) + ["xxx" "xx" "x"])))) + +(ert-deftest test-seq-random-elt-take-all () + (let ((seq '(a b c d e)) + (elts '())) + (should (= 0 (length elts))) + (dotimes (_ 1000) + (let ((random-elt (seq-random-elt seq))) + (add-to-list 'elts + random-elt))) + (should (= 5 (length elts))))) + +(ert-deftest test-seq-random-elt-signal-on-empty () + (should-error (seq-random-elt nil)) + (should-error (seq-random-elt [])) + (should-error (seq-random-elt ""))) + +(ert-deftest test-seq-mapn-circular-lists () + (let ((l1 '#1=(1 . #1#))) + (should (equal (seq-mapn #'+ '(3 4 5 7) l1) + '(4 5 6 8))))) + +(ert-deftest test-seq-into-and-identity () + (let ((lst '(1 2 3)) + (vec [1 2 3]) + (str "foo bar")) + (should (eq (seq-into lst 'list) lst)) + (should (eq (seq-into vec 'vector) vec)) + (should (eq (seq-into str 'string) str)))) + (provide 'seq-tests) ;;; seq-tests.el ends here diff --git a/test/automated/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index e30b5d8f549..e30b5d8f549 100644 --- a/test/automated/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el diff --git a/test/automated/tabulated-list-test.el b/test/lisp/emacs-lisp/tabulated-list-test.el index 0fb8dee7fd1..0fb8dee7fd1 100644 --- a/test/automated/tabulated-list-test.el +++ b/test/lisp/emacs-lisp/tabulated-list-test.el diff --git a/test/automated/thunk-tests.el b/test/lisp/emacs-lisp/thunk-tests.el index f995d362c7d..f995d362c7d 100644 --- a/test/automated/thunk-tests.el +++ b/test/lisp/emacs-lisp/thunk-tests.el diff --git a/test/automated/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index e3cdec73232..e3cdec73232 100644 --- a/test/automated/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el diff --git a/test/automated/viper-tests.el b/test/lisp/emulation/viper-tests.el index 0d6095b2c92..2c63b24fae0 100644 --- a/test/automated/viper-tests.el +++ b/test/lisp/emulation/viper-tests.el @@ -78,7 +78,7 @@ after itself, although it will leave a buffer called (viper-test-undo-kmacro []))) (ert-deftest viper-test-undo-1 () - "Test for VI like undo behaviour. + "Test for VI like undo behavior. Insert 1, then 2 on consecutive lines, followed by undo. This should leave just 1 in the buffer. @@ -100,7 +100,7 @@ Test for Bug #22295" )))) (ert-deftest viper-test-undo-2 () - "Test for VI like undo behaviour. + "Test for VI like undo behavior. Insert \"1 2 3 4 5\" then delete the 2, then the 4, and undo. Should restore the 4, but leave the 2 deleted. @@ -120,7 +120,7 @@ Test for Bug #22295" ])))) (ert-deftest viper-test-undo-3 () - "Test for VI like undo behaviour. + "Test for VI like undo behavior. Insert \"1 2 3 4 5 6\", delete the 2, then the 3 4 and 5. Should restore the 3 4 and 5 but not the 2. diff --git a/test/automated/epg-tests.el b/test/lisp/epg-tests.el index 4a317974ef5..d51ab23f71e 100644 --- a/test/automated/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -30,16 +30,17 @@ (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY")) "Directory containing epg test data.") -(defun epg-tests-gpg-usable (&optional require-passphrase) - (and (executable-find epg-gpg-program) - (condition-case nil - (progn - (epg-check-configuration (epg-configuration)) - (if require-passphrase - (string-match "\\`1\\." - (cdr (assq 'version (epg-configuration)))) - t)) - (error nil)))) +(defconst epg-tests-program-alist-for-passphrase-callback + '((OpenPGP + nil + ("gpg" . "1.4.3")))) + +(defun epg-tests-find-usable-gpg-configuration (&optional require-passphrase) + (epg-find-configuration + 'OpenPGP + 'no-cache + (if require-passphrase + epg-tests-program-alist-for-passphrase-callback))) (defun epg-tests-passphrase-callback (_c _k _d) ;; Need to create a copy here, since the string will be wiped out @@ -52,9 +53,14 @@ &rest body) "Set up temporary locations and variables for testing." (declare (indent 1)) - `(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t))) + `(let ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t))) (unwind-protect (let ((context (epg-make-context 'OpenPGP))) + (setf (epg-context-program context) + (alist-get 'program + (epg-tests-find-usable-gpg-configuration + ,(if require-passphrase + `'require-passphrase)))) (setf (epg-context-home-directory context) epg-tests-home-directory) (setenv "GPG_AGENT_INFO") @@ -78,7 +84,7 @@ (delete-directory epg-tests-home-directory t))))) (ert-deftest epg-decrypt-1 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t) (should (equal "test" (epg-decrypt-string epg-tests-context "\ @@ -90,14 +96,14 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== -----END PGP MESSAGE-----"))))) (ert-deftest epg-roundtrip-1 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t) (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil))) (should (equal "symmetric" (epg-decrypt-string epg-tests-context cipher)))))) (ert-deftest epg-roundtrip-2 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -108,7 +114,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (epg-decrypt-string epg-tests-context cipher)))))) (ert-deftest epg-sign-verify-1 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -122,7 +128,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-sign-verify-2 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -138,7 +144,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-sign-verify-3 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase t :require-public-key t :require-secret-key t) @@ -153,7 +159,7 @@ jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA== (should (eq 'good (epg-signature-status (car verify-result))))))) (ert-deftest epg-import-1 () - (skip-unless (epg-tests-gpg-usable 'require-passphrase)) + (skip-unless (epg-tests-find-usable-gpg-configuration 'require-passphrase)) (with-epg-tests (:require-passphrase nil) (should (= 0 (length (epg-list-keys epg-tests-context)))) (should (= 0 (length (epg-list-keys epg-tests-context nil t))))) diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el new file mode 100644 index 00000000000..7cf3ef7bb2f --- /dev/null +++ b/test/lisp/erc/erc-track-tests.el @@ -0,0 +1,122 @@ +;;; erc-track-tests.el --- Tests for erc-track. + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Mario Lang <mlang@delysid.org> +;; Author: Vivek Dasmohapatra <vivek@etla.org> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'erc-track) +(require 'font-core) + +(ert-deftest erc-track--shorten-aggressive-nil () + "Test non-aggressive erc track buffer name shortening." + (let (erc-track-shorten-aggressively) + (should + (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi")) + '("#em" "#vi"))) + (should + (equal (erc-unique-channel-names '("#linux-de" "#linux-fr") + '("#linux-de" "#linux-fr")) + '("#linux-de" "#linux-fr"))) + (should + (equal (erc-unique-channel-names + '("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile" "#testgnome" + "#gnu" "#fsbot" "#hurd" "#hurd-bunny" "#emacs") + '("#hurd-bunny" "#hurd" "#sawfish" "#lisp")) + '("#hurd-" "#hurd" "#s" "#l"))) + (should + (equal (erc-unique-substrings '("#emacs" "#vi" "#electronica" "#folk")) + '("#em" "#vi" "#el" "#f"))) + (should + (equal (erc-unique-channel-names + '("#emacs" "#burse" "+linux.de" "#starwars" + "#bitlbee" "+burse" "#ratpoison") + '("+linux.de" "#starwars" "#burse")) + '("+l" "#s" "#bu"))) + (should + (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego") '("fsbot")) + '("fs"))) + (should + (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego") + '("fsbot") + (lambda (s) (> (length s) 4)) 1) + '("f"))) + (should + (equal (erc-unique-channel-names '("fsbot" "#emacs" "deego") + '("fsbot") + (lambda (s) (> (length s) 4)) 2) + '("fs"))) + (should + (equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs") + '("#hurd" "#hurd-bunny")) + '("#hurd" "#hurd-"))) + (should + (and + (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") + (not (erc-unique-substring-1 "a" '("xyz" "xab"))) + (equal (erc-unique-substrings '("abc" "xyz" "xab")) '("abc" "xyz" "xab")) + (equal (erc-unique-substrings '("abc" "abcdefg")) '("abc" "abcd")))) )) + +(ert-deftest erc-track--shorten-aggressive-t () + "Test aggressive erc track buffer name shortening." + (let ((erc-track-shorten-aggressively t)) + (should + (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi")) + '("#em" "#v"))) + (should + (equal (erc-unique-channel-names '("#linux-de" "#linux-fr") + '("#linux-de" "#linux-fr")) + '("#linux-d" "#linux-f"))) + (should + (equal (erc-unique-substrings '("#emacs" "#vi" "#electronica" "#folk")) + '("#em" "#v" "#el" "#f"))) + (should + (and + (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd") + (not (erc-unique-substring-1 "a" '("xyz" "xab"))) + (equal (erc-unique-substrings '("abc" "xyz" "xab")) '("ab" "xy" "xa")) + (equal (erc-unique-substrings '("abc" "abcdefg")) '("abc" "abcd")))) )) + +(ert-deftest erc-track--shorten-aggressive-max () + "Test maximally aggressive erc track buffer name shortening." + (let ((erc-track-shorten-aggressively 'max)) + (should + (equal (erc-unique-channel-names '("#emacs" "#vi" "#electronica" "#folk") + '("#emacs" "#vi")) + '("#e" "#v"))) )) + +(ert-deftest erc-track--erc-faces-in () + "`erc-faces-in' should pick up both 'face and 'font-lock-face properties." + (let ((str0 "is bold") + (str1 "is bold")) + ;; Turn on Font Lock mode: this initialize `char-property-alias-alist' + ;; to '((face font-lock-face)). Note that `font-lock-mode' don't + ;; turn on the mode if the test is run on batch mode or if the + ;; buffer name starts with ?\s (Bug#23954). + (unless font-lock-mode (font-lock-default-function 1)) + (put-text-property 3 (length str0) 'font-lock-face + '(bold erc-current-nick-face) str0) + (put-text-property 3 (length str1) 'face + '(bold erc-current-nick-face) str1) + (should (erc-faces-in str0)) + (should (erc-faces-in str1)) )) diff --git a/test/automated/eshell.el b/test/lisp/eshell/eshell.el index d5676dd1daf..d5676dd1daf 100644 --- a/test/automated/eshell.el +++ b/test/lisp/eshell/eshell.el diff --git a/test/automated/faces-tests.el b/test/lisp/faces-tests.el index 809ba24d210..809ba24d210 100644 --- a/test/automated/faces-tests.el +++ b/test/lisp/faces-tests.el diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el new file mode 100644 index 00000000000..61fa891fe72 --- /dev/null +++ b/test/lisp/ffap-tests.el @@ -0,0 +1,54 @@ +;;; ffap-tests.el --- Test suite for ffap.el -*- lexical-binding: t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Tino Calancha <tino.calancha@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ffap) + +(ert-deftest ffap-tests-25243 () + "Test for http://debbugs.gnu.org/25243 ." + (let ((file (make-temp-file "test-Bug#25243"))) + (unwind-protect + (with-temp-file file + (let ((str "diff --git b/lisp/ffap.el a/lisp/ffap.el +index 3d7cebadcf..ad4b70d737 100644 +--- b/lisp/ffap.el ++++ a/lisp/ffap.el +@@ -203,6 +203,9 @@ ffap-foo-at-bar-prefix +")) + (transient-mark-mode 1) + (when (natnump ffap-max-region-length) + (insert + (concat + str + (make-string ffap-max-region-length #xa) + (format "%s ENDS HERE" file))) + (mark-whole-buffer) + (should (equal "" (ffap-string-at-point))) + (should (equal '(1 1) ffap-string-at-point-region))))) + (and (file-exists-p file) (delete-file file))))) + +(provide 'ffap-tests) + +;;; ffap-tests.el ends here diff --git a/test/automated/file-notify-tests.el b/test/lisp/filenotify-tests.el index 9f0c0ed0dc1..bd7f191dac6 100644 --- a/test/automated/file-notify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -1,4 +1,4 @@ -;;; file-notify-tests.el --- Tests of file notifications -*- lexical-binding: t; -*- +;;; filenotify-tests.el --- Tests of file notifications -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. @@ -64,18 +64,68 @@ (defvar file-notify--test-event nil) (defvar file-notify--test-events nil) -(defconst file-notify--test-read-event-timeout 0.01 - "Timeout for `read-event' calls. -It is different for local and remote file notification libraries.") +(defun file-notify--test-read-event () + "Read one event. +There are different timeouts for local and remote file notification libraries." + (read-event + nil nil + (cond + ;; gio/gpollfilemonitor.c declares POLL_TIME_SECS 5. So we must + ;; wait at least this time in the GPollFileMonitor case. A + ;; similar timeout seems to be needed in the GFamFileMonitor case, + ;; at least on Cygwin. + ((and (string-equal (file-notify--test-library) "gfilenotify") + (memq (file-notify--test-monitor) + '(GFamFileMonitor GPollFileMonitor))) + 7) + ((file-remote-p temporary-file-directory) 0.1) + (t 0.01)))) (defun file-notify--test-timeout () - "Timeout to wait for arriving events, in seconds." + "Timeout to wait for arriving a bunch of events, in seconds." (cond ((file-remote-p temporary-file-directory) 6) ((string-equal (file-notify--test-library) "w32notify") 4) - ((eq system-type 'cygwin) 10) + ((eq system-type 'cygwin) 6) (t 3))) +(defmacro file-notify--wait-for-events (timeout until) + "Wait for and return file notification events until form UNTIL is true. +TIMEOUT is the maximum time to wait for, in seconds." + `(with-timeout (,timeout (ignore)) + (while (null ,until) + (file-notify--test-read-event)))) + +(defun file-notify--test-no-descriptors () + "Check that `file-notify-descriptors' is an empty hash table. +Return nil when any other file notification watch is still active." + ;; Give read events a last chance. + (file-notify--wait-for-events + (file-notify--test-timeout) + (zerop (hash-table-count file-notify-descriptors))) + ;; Now check. + (zerop (hash-table-count file-notify-descriptors))) + +(defun file-notify--test-no-descriptors-explainer () + "Explain why `file-notify--test-no-descriptors' fails." + (let ((result (list "Watch descriptor(s) existent:"))) + (maphash + (lambda (key value) (push (cons key value) result)) + file-notify-descriptors) + (nreverse result))) + +(put 'file-notify--test-no-descriptors 'ert-explainer + 'file-notify--test-no-descriptors-explainer) + +(defun file-notify--test-cleanup-p () + "Check, that the test has cleaned up the environment as much as needed." + ;; `file-notify--test-event' should not be set but bound + ;; dynamically. + (should-not file-notify--test-event) + ;; The test should have cleaned up this already. Let's check + ;; nevertheless. + (should (file-notify--test-no-descriptors))) + (defun file-notify--test-cleanup () "Cleanup after a test." (file-notify-rm-watch file-notify--test-desc) @@ -103,9 +153,7 @@ It is different for local and remote file notification libraries.") file-notify--test-desc1 nil file-notify--test-desc2 nil file-notify--test-results nil - file-notify--test-events nil) - (when file-notify--test-event - (error "file-notify--test-event should not be set but bound dynamically"))) + file-notify--test-events nil)) (setq password-cache-expiry nil tramp-verbose 0 @@ -140,7 +188,7 @@ being the result.") (setq desc (file-notify-add-watch file-notify-test-remote-temporary-file-directory - '(change) 'ignore)))) + '(change) #'ignore)))) (setq file-notify--test-remote-enabled-checked (cons t desc)) (when desc (file-notify-rm-watch desc)))) ;; Return result. @@ -158,6 +206,15 @@ remote host, or nil." "<[[:digit:]]+>\\'" "" (process-name (cdr file-notify--test-remote-enabled-checked)))))) +(defun file-notify--test-monitor () + "The used monitor for the test, as a symbol. +This returns only for the local case and gfilenotify; otherwise it is nil. +`file-notify--test-desc' must be a valid watch descriptor." + (and file-notify--test-desc + (null (file-remote-p temporary-file-directory)) + (functionp 'gfile-monitor-name) + (gfile-monitor-name file-notify--test-desc))) + (defmacro file-notify--deftest-remote (test docstring) "Define ert `TEST-remote' for remote files." (declare (indent 1)) @@ -166,7 +223,6 @@ remote host, or nil." :tags '(:expensive-test) (let* ((temporary-file-directory file-notify-test-remote-temporary-file-directory) - (file-notify--test-read-event-timeout 0.1) (ert-test (ert-get-test ',test))) (skip-unless (file-notify--test-remote-enabled)) (tramp-cleanup-connection @@ -176,14 +232,24 @@ remote host, or nil." (ert-deftest file-notify-test00-availability () "Test availability of `file-notify'." (skip-unless (file-notify--test-local-enabled)) - ;; Report the native library which has been used. - (message "Library: `%s'" (file-notify--test-library)) - (should - (setq file-notify--test-desc - (file-notify-add-watch temporary-file-directory '(change) 'ignore))) - ;; Cleanup. - (file-notify--test-cleanup)) + (unwind-protect + (progn + ;; Report the native library which has been used. + (message "Library: `%s'" (file-notify--test-library)) + (should + (setq file-notify--test-desc + (file-notify-add-watch + temporary-file-directory '(change) #'ignore))) + (when (file-notify--test-monitor) + (message "Monitor: `%s'" (file-notify--test-monitor))) + (file-notify-rm-watch file-notify--test-desc) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) + + ;; Cleanup. + (file-notify--test-cleanup))) (file-notify--deftest-remote file-notify-test00-availability "Test availability of `file-notify' for remote files.") @@ -192,58 +258,66 @@ remote host, or nil." "Check `file-notify-add-watch'." (skip-unless (file-notify--test-local-enabled)) - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) - file-notify--test-tmpfile1 - (format "%s/%s" file-notify--test-tmpfile (md5 (current-time-string)))) + (unwind-protect + (progn + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name) + file-notify--test-tmpfile1 + (format + "%s/%s" file-notify--test-tmpfile (md5 (current-time-string)))) - ;; Check, that different valid parameters are accepted. - (should - (setq file-notify--test-desc - (file-notify-add-watch temporary-file-directory '(change) 'ignore))) - (file-notify-rm-watch file-notify--test-desc) - (should - (setq file-notify--test-desc - (file-notify-add-watch - temporary-file-directory '(attribute-change) 'ignore))) - (file-notify-rm-watch file-notify--test-desc) - (should - (setq file-notify--test-desc - (file-notify-add-watch - temporary-file-directory '(change attribute-change) 'ignore))) - (file-notify-rm-watch file-notify--test-desc) - (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (should - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile '(change attribute-change) 'ignore))) - (file-notify-rm-watch file-notify--test-desc) - (delete-file file-notify--test-tmpfile) + ;; Check, that different valid parameters are accepted. + (should + (setq file-notify--test-desc + (file-notify-add-watch + temporary-file-directory '(change) #'ignore))) + (file-notify-rm-watch file-notify--test-desc) + (should + (setq file-notify--test-desc + (file-notify-add-watch + temporary-file-directory '(attribute-change) #'ignore))) + (file-notify-rm-watch file-notify--test-desc) + (should + (setq file-notify--test-desc + (file-notify-add-watch + temporary-file-directory '(change attribute-change) #'ignore))) + (file-notify-rm-watch file-notify--test-desc) + (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile '(change attribute-change) #'ignore))) + (file-notify-rm-watch file-notify--test-desc) + (delete-file file-notify--test-tmpfile) - ;; Check error handling. - (should-error (file-notify-add-watch 1 2 3 4) - :type 'wrong-number-of-arguments) - (should - (equal (should-error - (file-notify-add-watch 1 2 3)) - '(wrong-type-argument 1))) - (should - (equal (should-error - (file-notify-add-watch temporary-file-directory 2 3)) - '(wrong-type-argument 2))) - (should - (equal (should-error - (file-notify-add-watch temporary-file-directory '(change) 3)) - '(wrong-type-argument 3))) - ;; The upper directory of a file must exist. - (should - (equal (should-error - (file-notify-add-watch - file-notify--test-tmpfile1 '(change attribute-change) 'ignore)) - `(file-notify-error - "Directory does not exist" ,file-notify--test-tmpfile))) + ;; Check error handling. + (should-error (file-notify-add-watch 1 2 3 4) + :type 'wrong-number-of-arguments) + (should + (equal (should-error + (file-notify-add-watch 1 2 3)) + '(wrong-type-argument 1))) + (should + (equal (should-error + (file-notify-add-watch temporary-file-directory 2 3)) + '(wrong-type-argument 2))) + (should + (equal (should-error + (file-notify-add-watch temporary-file-directory '(change) 3)) + '(wrong-type-argument 3))) + ;; The upper directory of a file must exist. + (should + (equal (should-error + (file-notify-add-watch + file-notify--test-tmpfile1 + '(change attribute-change) #'ignore)) + `(file-notify-error + "Directory does not exist" ,file-notify--test-tmpfile))) - ;; Cleanup. - (file-notify--test-cleanup)) + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) + + ;; Cleanup. + (file-notify--test-cleanup))) (file-notify--deftest-remote file-notify-test01-add-watch "Check `file-notify-add-watch' for remote files.") @@ -289,28 +363,25 @@ and the event to `file-notify--test-events'." (expand-file-name (make-temp-name "file-notify-test") temporary-file-directory)) -(defmacro file-notify--wait-for-events (timeout until) - "Wait for and return file notification events until form UNTIL is true. -TIMEOUT is the maximum time to wait for, in seconds." - `(with-timeout (,timeout (ignore)) - (while (null ,until) - (read-event nil nil file-notify--test-read-event-timeout)))) - (defun file-notify--test-with-events-check (events) "Check whether received events match one of the EVENTS alternatives." (let (result) (dolist (elt events result) (setq result (or result - (equal elt (mapcar #'cadr file-notify--test-events))))))) + (if (eq (car elt) :random) + (equal (sort (cdr elt) 'string-lessp) + (sort (mapcar #'cadr file-notify--test-events) + 'string-lessp)) + (equal elt (mapcar #'cadr file-notify--test-events)))))))) (defun file-notify--test-with-events-explainer (events) "Explain why `file-notify--test-with-events-check' fails." (if (null (cdr events)) - (format "Received events `%s' do not match expected events `%s'" + (format "Received events do not match expected events\n%s\n%s" (mapcar #'cadr file-notify--test-events) (car events)) (format - "Received events `%s' do not match any sequence of expected events `%s'" + "Received events do not match any sequence of expected events\n%s\n%s" (mapcar #'cadr file-notify--test-events) events))) (put 'file-notify--test-with-events-check 'ert-explainer @@ -319,16 +390,26 @@ TIMEOUT is the maximum time to wait for, in seconds." (defmacro file-notify--test-with-events (events &rest body) "Run BODY collecting events and then compare with EVENTS. EVENTS is either a simple list of events, or a list of lists of -events, which represent different possible results. Don't wait -longer than timeout seconds for the events to be delivered." +events, which represent different possible results. The first +event of a list could be the pseudo event `:random', which is +just an indicator for comparison. + +Don't wait longer than timeout seconds for the events to be +delivered." (declare (indent 1)) `(let* ((events (if (consp (car ,events)) ,events (list ,events))) - (max-length (apply 'max (mapcar 'length events))) + (max-length + (apply + 'max + (mapcar + (lambda (x) (length (if (eq (car x) :random) (cdr x) x))) + events))) create-lockfiles) ;; Flush pending events. + (file-notify--test-read-event) (file-notify--wait-for-events (file-notify--test-timeout) - (input-pending-p)) + (not (input-pending-p))) (setq file-notify--test-events nil file-notify--test-results nil) ,@body @@ -352,25 +433,24 @@ longer than timeout seconds for the events to be delivered." (unwind-protect (progn ;; Check file creation, change and deletion. It doesn't work - ;; for cygwin and kqueue, because we don't use an implicit - ;; directory monitor (kqueue), or the timings are too bad (cygwin). - (unless (or (eq system-type 'cygwin) - (string-equal (file-notify--test-library) "kqueue")) + ;; for kqueue, because we don't use an implicit directory + ;; monitor. + (unless (string-equal (file-notify--test-library) "kqueue") (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) (should (setq file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler))) + '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events (cond - ;; cygwin recognizes only `deleted' and `stopped' events. + ;; cygwin does not raise a `changed' event. ((eq system-type 'cygwin) - '(deleted stopped)) + '(created deleted stopped)) (t '(created changed deleted stopped))) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc)) @@ -381,26 +461,14 @@ longer than timeout seconds for the events to be delivered." (setq file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler))) + '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events - (cond - ;; cygwin recognizes only `deleted' and `stopped' events. - ((eq system-type 'cygwin) - '(deleted stopped)) - ;; inotify and kqueue raise just one `changed' event. - ((or (string-equal "inotify" (file-notify--test-library)) - (string-equal "kqueue" (file-notify--test-library))) - '(changed deleted stopped)) - ;; gfilenotify raises one or two `changed' events - ;; randomly, no chance to test. So we accept both cases. - ((string-equal "gfilenotify" (file-notify--test-library)) - '((changed deleted stopped) - (changed changed deleted stopped))) - (t '(changed changed deleted stopped))) - (read-event nil nil file-notify--test-read-event-timeout) + ;; There could be one or two `changed' events. + '((changed deleted stopped) + (changed changed deleted stopped)) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (delete-file file-notify--test-tmpfile)) (file-notify-rm-watch file-notify--test-desc) @@ -414,26 +482,25 @@ longer than timeout seconds for the events to be delivered." file-notify--test-desc (file-notify-add-watch temporary-file-directory - '(change) 'file-notify--test-event-handler))) + '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events (cond ;; w32notify does not raise `deleted' and `stopped' ;; events for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '(created changed deleted)) - ;; cygwin recognizes only `deleted' and `stopped' events. - ((eq system-type 'cygwin) - '(deleted stopped)) ;; There are two `deleted' events, for the file and for - ;; the directory. Except for kqueue. + ;; the directory. Except for cygwin and kqueue. And + ;; cygwin does not raise a `changed' event. + ((eq system-type 'cygwin) + '(created deleted stopped)) ((string-equal (file-notify--test-library) "kqueue") '(created changed deleted stopped)) (t '(created changed deleted deleted stopped))) - (read-event nil nil file-notify--test-read-event-timeout) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) - (delete-directory temporary-file-directory 'recursive)) + (file-notify--test-read-event) + (delete-directory temporary-file-directory 'recursive)) (file-notify-rm-watch file-notify--test-desc)) ;; Check copy of files inside a directory. @@ -445,7 +512,7 @@ longer than timeout seconds for the events to be delivered." file-notify--test-desc (file-notify-add-watch temporary-file-directory - '(change) 'file-notify--test-event-handler))) + '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events (cond ;; w32notify does not distinguish between `changed' and @@ -455,27 +522,25 @@ longer than timeout seconds for the events to be delivered." '(created changed created changed changed changed changed deleted deleted)) - ;; cygwin recognizes only `deleted' and `stopped' events. - ((eq system-type 'cygwin) - '(deleted stopped)) ;; There are three `deleted' events, for two files and - ;; for the directory. Except for kqueue. + ;; for the directory. Except for cygwin and kqueue. + ((eq system-type 'cygwin) + '(created created changed changed deleted stopped)) ((string-equal (file-notify--test-library) "kqueue") '(created changed created changed deleted stopped)) (t '(created changed created changed deleted deleted deleted stopped))) - (read-event nil nil file-notify--test-read-event-timeout) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (copy-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; The next two events shall not be visible. - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (set-file-modes file-notify--test-tmpfile 000) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (set-file-times file-notify--test-tmpfile '(0 0)) - (read-event nil nil file-notify--test-read-event-timeout) - (delete-directory temporary-file-directory 'recursive)) + (file-notify--test-read-event) + (delete-directory temporary-file-directory 'recursive)) (file-notify-rm-watch file-notify--test-desc)) ;; Check rename of files inside a directory. @@ -487,33 +552,34 @@ longer than timeout seconds for the events to be delivered." file-notify--test-desc (file-notify-add-watch temporary-file-directory - '(change) 'file-notify--test-event-handler))) + '(change) #'file-notify--test-event-handler))) (file-notify--test-with-events (cond ;; w32notify does not raise `deleted' and `stopped' ;; events for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '(created changed renamed deleted)) - ;; cygwin recognizes only `deleted' and `stopped' events. - ((eq system-type 'cygwin) - '(deleted stopped)) ;; There are two `deleted' events, for the file and for - ;; the directory. Except for kqueue. + ;; the directory. Except for cygwin and kqueue. And + ;; cygwin raises `created' and `deleted' events instead + ;; of a `renamed' event. + ((eq system-type 'cygwin) + '(created created deleted deleted stopped)) ((string-equal (file-notify--test-library) "kqueue") '(created changed renamed deleted stopped)) (t '(created changed renamed deleted deleted stopped))) - (read-event nil nil file-notify--test-read-event-timeout) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (rename-file file-notify--test-tmpfile file-notify--test-tmpfile1) ;; After the rename, we won't get events anymore. - (read-event nil nil file-notify--test-read-event-timeout) - (delete-directory temporary-file-directory 'recursive)) + (file-notify--test-read-event) + (delete-directory temporary-file-directory 'recursive)) (file-notify-rm-watch file-notify--test-desc)) ;; Check attribute change. Does not work for cygwin. - (unless (eq system-type 'cygwin) + (unless (and (eq system-type 'cygwin) + (not (file-remote-p temporary-file-directory))) (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) @@ -521,29 +587,34 @@ longer than timeout seconds for the events to be delivered." (setq file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile - '(attribute-change) 'file-notify--test-event-handler))) + '(attribute-change) #'file-notify--test-event-handler))) (file-notify--test-with-events (cond ;; w32notify does not distinguish between `changed' and - ;; `attribute-changed'. + ;; `attribute-changed'. Under MS Windows 7, we get + ;; four `changed' events, and under MS Windows 10 just + ;; two. Strange. ((string-equal (file-notify--test-library) "w32notify") - '(changed changed changed changed)) + '((changed changed) + (changed changed changed changed))) ;; For kqueue and in the remote case, `write-region' ;; raises also an `attribute-changed' event. ((or (string-equal (file-notify--test-library) "kqueue") (file-remote-p temporary-file-directory)) '(attribute-changed attribute-changed attribute-changed)) (t '(attribute-changed attribute-changed))) - (read-event nil nil file-notify--test-read-event-timeout) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (set-file-modes file-notify--test-tmpfile 000) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (set-file-times file-notify--test-tmpfile '(0 0)) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (delete-file file-notify--test-tmpfile)) - (file-notify-rm-watch file-notify--test-desc))) + (file-notify-rm-watch file-notify--test-desc)) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup))) @@ -559,6 +630,7 @@ longer than timeout seconds for the events to be delivered." (ert-deftest file-notify-test03-autorevert () "Check autorevert via file notification." (skip-unless (file-notify--test-local-enabled)) + ;; `auto-revert-buffers' runs every 5". And we must wait, until the ;; file has been reverted. (let ((timeout (if (file-remote-p temporary-file-directory) 60 10)) @@ -566,7 +638,6 @@ longer than timeout seconds for the events to be delivered." (unwind-protect (progn (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) - (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (setq buf (find-file-noselect file-notify--test-tmpfile)) @@ -628,7 +699,10 @@ longer than timeout seconds for the events to be delivered." (string-match (format-message "Reverting buffer `%s'." (buffer-name buf)) (buffer-string)))) - (should (string-match "foo bla" (buffer-string))))) + (should (string-match "foo bla" (buffer-string)))) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (with-current-buffer "*Messages*" (widen)) @@ -649,14 +723,16 @@ longer than timeout seconds for the events to be delivered." (should (setq file-notify--test-desc (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler))) + file-notify--test-tmpfile '(change) #'ignore))) (should (file-notify-valid-p file-notify--test-desc)) ;; After calling `file-notify-rm-watch', the descriptor is not ;; valid anymore. (file-notify-rm-watch file-notify--test-desc) (should-not (file-notify-valid-p file-notify--test-desc)) - (delete-file file-notify--test-tmpfile)) + (delete-file file-notify--test-tmpfile) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup)) @@ -670,30 +746,21 @@ longer than timeout seconds for the events to be delivered." (file-notify-add-watch file-notify--test-tmpfile '(change) #'file-notify--test-event-handler))) + (should (file-notify-valid-p file-notify--test-desc)) (file-notify--test-with-events - (cond - ;; cygwin recognizes only `deleted' and `stopped' events. - ((eq system-type 'cygwin) - '(deleted stopped)) - ;; inotify and kqueue raise just one `changed' event. - ((or (string-equal "inotify" (file-notify--test-library)) - (string-equal "kqueue" (file-notify--test-library))) - '(changed deleted stopped)) - ;; gfilenotify raises one or two `changed' events - ;; randomly, no chance to test. So we accept both cases. - ((string-equal "gfilenotify" (file-notify--test-library)) - '((changed deleted stopped) - (changed changed deleted stopped))) - (t '(changed changed deleted stopped))) - (should (file-notify-valid-p file-notify--test-desc)) - (read-event nil nil file-notify--test-read-event-timeout) + ;; There could be one or two `changed' events. + '((changed deleted stopped) + (changed changed deleted stopped)) (write-region "another text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (delete-file file-notify--test-tmpfile)) ;; After deleting the file, the descriptor is not valid anymore. (should-not (file-notify-valid-p file-notify--test-desc)) - (file-notify-rm-watch file-notify--test-desc)) + (file-notify-rm-watch file-notify--test-desc) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup)) @@ -707,29 +774,31 @@ longer than timeout seconds for the events to be delivered." (file-notify-add-watch temporary-file-directory '(change) #'file-notify--test-event-handler))) + (should (file-notify-valid-p file-notify--test-desc)) (file-notify--test-with-events (cond ;; w32notify does not raise `deleted' and `stopped' events ;; for the watched directory. ((string-equal (file-notify--test-library) "w32notify") '(created changed deleted)) - ;; cygwin recognizes only `deleted' and `stopped' events. - ((eq system-type 'cygwin) - '(deleted stopped)) ;; There are two `deleted' events, for the file and for the - ;; directory. Except for kqueue. + ;; directory. Except for cygwin and kqueue. And cygwin + ;; does not raise a `changed' event. + ((eq system-type 'cygwin) + '(created deleted stopped)) ((string-equal (file-notify--test-library) "kqueue") '(created changed deleted stopped)) (t '(created changed deleted deleted stopped))) - (should (file-notify-valid-p file-notify--test-desc)) - (read-event nil nil file-notify--test-read-event-timeout) (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (delete-directory temporary-file-directory t)) ;; After deleting the parent directory, the descriptor must ;; not be valid anymore. - (should-not (file-notify-valid-p file-notify--test-desc))) + (should-not (file-notify-valid-p file-notify--test-desc)) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup))) @@ -743,14 +812,13 @@ longer than timeout seconds for the events to be delivered." (unwind-protect (progn - (setq file-notify--test-tmpfile - (file-name-as-directory (file-notify--test-make-temp-name))) - (make-directory file-notify--test-tmpfile) + (should + (setq file-notify--test-tmpfile + (make-temp-file "file-notify-test-parent" t))) (should (setq file-notify--test-desc (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler))) + file-notify--test-tmpfile '(change) #'ignore))) (should (file-notify-valid-p file-notify--test-desc)) ;; After removing the watch, the descriptor must not be valid ;; anymore. @@ -758,21 +826,24 @@ longer than timeout seconds for the events to be delivered." (file-notify--wait-for-events (file-notify--test-timeout) (not (file-notify-valid-p file-notify--test-desc))) - (should-not (file-notify-valid-p file-notify--test-desc))) + (should-not (file-notify-valid-p file-notify--test-desc)) + (delete-directory file-notify--test-tmpfile t) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup)) (unwind-protect (progn - (setq file-notify--test-tmpfile - (file-name-as-directory (file-notify--test-make-temp-name))) - (make-directory file-notify--test-tmpfile) + (should + (setq file-notify--test-tmpfile + (make-temp-file "file-notify-test-parent" t))) (should (setq file-notify--test-desc (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler))) + file-notify--test-tmpfile '(change) #'ignore))) (should (file-notify-valid-p file-notify--test-desc)) ;; After deleting the directory, the descriptor must not be ;; valid anymore. @@ -780,7 +851,10 @@ longer than timeout seconds for the events to be delivered." (file-notify--wait-for-events (file-notify--test-timeout) (not (file-notify-valid-p file-notify--test-desc))) - (should-not (file-notify-valid-p file-notify--test-desc))) + (should-not (file-notify-valid-p file-notify--test-desc)) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup))) @@ -792,16 +866,15 @@ longer than timeout seconds for the events to be delivered." "Check that events are not dropped." :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) - ;; Under cygwin events arrive in random order. Impossible to define a test. - (skip-unless (not (eq system-type 'cygwin))) - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) - (make-directory file-notify--test-tmpfile) + (should + (setq file-notify--test-tmpfile + (make-temp-file "file-notify-test-parent" t))) (should (setq file-notify--test-desc (file-notify-add-watch file-notify--test-tmpfile - '(change) 'file-notify--test-event-handler))) + '(change) #'file-notify--test-event-handler))) (unwind-protect (let ((n 1000) source-file-list target-file-list @@ -820,9 +893,9 @@ longer than timeout seconds for the events to be delivered." (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (write-region "" nil (pop source-file-list) nil 'no-message) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (write-region "" nil (pop target-file-list) nil 'no-message)))) (file-notify--test-with-events (cond @@ -831,16 +904,26 @@ longer than timeout seconds for the events to be delivered." (let (r) (dotimes (_i n r) (setq r (append '(deleted renamed) r))))) + ;; cygwin fires `changed' and `deleted' events, sometimes + ;; in random order. + ((eq system-type 'cygwin) + (let (r) + (dotimes (_i n (cons :random r)) + (setq r (append '(changed deleted) r))))) (t (make-list n 'renamed))) (let ((source-file-list source-file-list) (target-file-list target-file-list)) (while (and source-file-list target-file-list) - (read-event nil nil file-notify--test-read-event-timeout) + (file-notify--test-read-event) (rename-file (pop source-file-list) (pop target-file-list) t)))) (file-notify--test-with-events (make-list n 'deleted) (dolist (file target-file-list) - (read-event nil nil file-notify--test-read-event-timeout) - (delete-file file) file-notify--test-read-event-timeout))) + (file-notify--test-read-event) + (delete-file file))) + (delete-directory file-notify--test-tmpfile) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup))) @@ -863,18 +946,9 @@ longer than timeout seconds for the events to be delivered." '(change) #'file-notify--test-event-handler))) (should (file-notify-valid-p file-notify--test-desc)) (file-notify--test-with-events - (cond - ;; For w32notify and in the remote case, there are two - ;; `changed' events. - ((or (string-equal (file-notify--test-library) "w32notify") - (file-remote-p temporary-file-directory)) - '(changed changed)) - ;; gfilenotify raises one or two `changed' events - ;; randomly, no chance to test. So we accept both cases. - ((string-equal "gfilenotify" (file-notify--test-library)) - '((changed) - (changed changed))) - (t '(changed))) + ;; There could be one or two `changed' events. + '((changed) + (changed changed)) ;; There shouldn't be any problem, because the file is kept. (with-temp-buffer (let ((buffer-file-name file-notify--test-tmpfile) @@ -886,40 +960,49 @@ longer than timeout seconds for the events to be delivered." (save-buffer)))) ;; After saving the buffer, the descriptor is still valid. (should (file-notify-valid-p file-notify--test-desc)) - (delete-file file-notify--test-tmpfile)) + (delete-file file-notify--test-tmpfile) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup)) (unwind-protect - (progn - ;; It doesn't work for kqueue, because we don't use an - ;; implicit directory monitor. - (unless (string-equal (file-notify--test-library) "kqueue") - (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) - (write-region - "any text" nil file-notify--test-tmpfile nil 'no-message) - (should - (setq file-notify--test-desc - (file-notify-add-watch - file-notify--test-tmpfile - '(change) #'file-notify--test-event-handler))) - (should (file-notify-valid-p file-notify--test-desc)) - (file-notify--test-with-events '(renamed created changed) - ;; The file is renamed when creating a backup. It shall - ;; still be watched. - (with-temp-buffer - (let ((buffer-file-name file-notify--test-tmpfile) - (make-backup-files t) - (backup-by-copying nil) - (backup-by-copying-when-mismatch nil) - (kept-new-versions 1) - (delete-old-versions t)) - (insert "another text") - (save-buffer)))) - ;; After saving the buffer, the descriptor is still valid. - (should (file-notify-valid-p file-notify--test-desc)) - (delete-file file-notify--test-tmpfile))) + ;; It doesn't work for kqueue, because we don't use an implicit + ;; directory monitor. + (unless (string-equal (file-notify--test-library) "kqueue") + (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)) + (write-region + "any text" nil file-notify--test-tmpfile nil 'no-message) + (should + (setq file-notify--test-desc + (file-notify-add-watch + file-notify--test-tmpfile + '(change) #'file-notify--test-event-handler))) + (should (file-notify-valid-p file-notify--test-desc)) + (file-notify--test-with-events + (cond + ;; On cygwin we only get the `changed' event. + ((eq system-type 'cygwin) '(changed)) + (t '(renamed created changed))) + ;; The file is renamed when creating a backup. It shall + ;; still be watched. + (with-temp-buffer + (let ((buffer-file-name file-notify--test-tmpfile) + (make-backup-files t) + (backup-by-copying nil) + (backup-by-copying-when-mismatch nil) + (kept-new-versions 1) + (delete-old-versions t)) + (insert "another text") + (save-buffer)))) + ;; After saving the buffer, the descriptor is still valid. + (should (file-notify-valid-p file-notify--test-desc)) + (delete-file file-notify--test-tmpfile) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup))) @@ -969,58 +1052,51 @@ the file watch." (should (file-notify-valid-p file-notify--test-desc1)) (should (file-notify-valid-p file-notify--test-desc2)) (should-not (equal file-notify--test-desc1 file-notify--test-desc2)) - ;; gfilenotify raises one or two `changed' events randomly in - ;; the file monitor, no chance to test. - (unless (string-equal "gfilenotify" (file-notify--test-library)) - (let ((n 100) events) - ;; Compute the expected events. - (dotimes (_i (/ n 2)) - (setq events - (append - (append - ;; Directory monitor and file monitor. - (cond - ;; In the remote case, there are two `changed' - ;; events. - ((file-remote-p temporary-file-directory) - '(changed changed changed changed)) - ;; The directory monitor in kqueue does not - ;; raise any `changed' event. Just the file - ;; monitor event is received. - ((string-equal (file-notify--test-library) "kqueue") - '(changed)) - ;; Otherwise, both monitors report the - ;; `changed' event. - (t '(changed changed))) - ;; Just the directory monitor. - (cond - ;; In kqueue, there is an additional `changed' - ;; event. Why? - ((string-equal (file-notify--test-library) "kqueue") - '(changed created changed)) - (t '(created changed)))) - events))) - - ;; Run the test. - (file-notify--test-with-events events - (dotimes (i n) - (read-event nil nil file-notify--test-read-event-timeout) - (if (zerop (mod i 2)) - (write-region - "any text" nil file-notify--test-tmpfile1 t 'no-message) - (let ((temporary-file-directory file-notify--test-tmpfile)) - (write-region - "any text" nil - (file-notify--test-make-temp-name) nil 'no-message))))))) + (let ((n 100)) + ;; Run the test. + (file-notify--test-with-events + ;; There could be one or two `changed' events. + (list + ;; cygwin. + (append + '(:random) + (make-list (/ n 2) 'changed) + (make-list (/ n 2) 'created) + (make-list (/ n 2) 'changed)) + (append + '(:random) + ;; Directory monitor and file monitor. + (make-list (/ n 2) 'changed) + (make-list (/ n 2) 'changed) + ;; Just the directory monitor. + (make-list (/ n 2) 'created) + (make-list (/ n 2) 'changed)) + (append + '(:random) + ;; Directory monitor and file monitor. + (make-list (/ n 2) 'changed) + (make-list (/ n 2) 'changed) + (make-list (/ n 2) 'changed) + (make-list (/ n 2) 'changed) + ;; Just the directory monitor. + (make-list (/ n 2) 'created) + (make-list (/ n 2) 'changed))) + (dotimes (i n) + (file-notify--test-read-event) + (if (zerop (mod i 2)) + (write-region + "any text" nil file-notify--test-tmpfile1 t 'no-message) + (let ((temporary-file-directory file-notify--test-tmpfile)) + (write-region + "any text" nil + (file-notify--test-make-temp-name) nil 'no-message)))))) ;; If we delete the file, the directory monitor shall still be ;; active. We receive the `deleted' event from both the ;; directory and the file monitor. The `stopped' event is ;; from the file monitor. It's undecided in which order the ;; the directory and the file monitor are triggered. - (file-notify--test-with-events - '((deleted deleted stopped) - (deleted stopped deleted)) + (file-notify--test-with-events '(:random deleted deleted stopped) (delete-file file-notify--test-tmpfile1)) (should (file-notify-valid-p file-notify--test-desc1)) (should-not (file-notify-valid-p file-notify--test-desc2)) @@ -1028,9 +1104,10 @@ the file watch." ;; Now we delete the directory. (file-notify--test-with-events (cond - ;; In kqueue, just one `deleted' event for the directory - ;; is received. - ((string-equal (file-notify--test-library) "kqueue") + ;; In kqueue and for cygwin, just one `deleted' event for + ;; the directory is received. + ((or (eq system-type 'cygwin) + (string-equal (file-notify--test-library) "kqueue")) '(deleted stopped)) (t (append ;; The directory monitor raises a `deleted' event for @@ -1050,7 +1127,10 @@ the file watch." (t '(deleted stopped)))))) (delete-directory file-notify--test-tmpfile 'recursive)) (should-not (file-notify-valid-p file-notify--test-desc1)) - (should-not (file-notify-valid-p file-notify--test-desc2))) + (should-not (file-notify-valid-p file-notify--test-desc2)) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) ;; Cleanup. (file-notify--test-cleanup))) @@ -1058,6 +1138,50 @@ the file watch." (file-notify--deftest-remote file-notify-test08-watched-file-in-watched-dir "Check `file-notify-test08-watched-file-in-watched-dir' for remote files.") +(ert-deftest file-notify-test09-sufficient-resources () + "Check that file notification does not use too many resources." + :tags '(:expensive-test) + (skip-unless (file-notify--test-local-enabled)) + ;; This test is intended for kqueue only. + (skip-unless (string-equal (file-notify--test-library) "kqueue")) + + (should + (setq file-notify--test-tmpfile + (make-temp-file "file-notify-test-parent" t))) + (unwind-protect + (let ((temporary-file-directory file-notify--test-tmpfile) + descs) + (should-error + (while t + ;; We watch directories, because we want to reach the upper + ;; limit. Watching a file might not be sufficient, because + ;; most of the libraries implement this as watching the + ;; upper directory. + (setq file-notify--test-tmpfile1 + (make-temp-file "file-notify-test-parent" t) + descs + (cons + (should + (file-notify-add-watch + file-notify--test-tmpfile1 '(change) #'ignore)) + descs))) + :type 'file-notify-error) + ;; Remove watches. If we don't do it prior removing + ;; directories, Emacs crashes in batch mode. + (dolist (desc descs) + (file-notify-rm-watch desc)) + ;; Remove directories. + (delete-directory file-notify--test-tmpfile 'recursive) + + ;; The environment shall be cleaned up. + (file-notify--test-cleanup-p)) + + ;; Cleanup. + (file-notify--test-cleanup))) + +(file-notify--deftest-remote file-notify-test09-sufficient-resources + "Check `file-notify-test09-sufficient-resources' for remote files.") + (defun file-notify-test-all (&optional interactive) "Run all tests for \\[file-notify]." (interactive "p") @@ -1071,9 +1195,10 @@ the file watch." ;; the missing directory monitor. ;; * For w32notify, no `deleted' and `stopped' events arrive when a ;; directory is removed. -;; * For w32notify, no `attribute-changed' events arrive. Its sends -;; `changed' events instead. -;; * Check, why cygwin recognizes only `deleted' and `stopped' events. +;; * For cygwin and w32notify, no `attribute-changed' events arrive. +;; They send `changed' events instead. +;; * cygwin does not send all expected `changed' and `deleted' events. +;; Probably due to timing issues. (provide 'file-notify-tests) -;;; file-notify-tests.el ends here +;;; filenotify-tests.el ends here diff --git a/test/automated/files.el b/test/lisp/files-tests.el index 3c6f61b792c..6fbe993bfdd 100644 --- a/test/automated/files.el +++ b/test/lisp/files-tests.el @@ -1,4 +1,4 @@ -;;; files.el --- tests for file handling. +;;; files-tests.el --- tests for files.el. ;; Copyright (C) 2012-2016 Free Software Foundation, Inc. @@ -169,4 +169,79 @@ form.") ;; Stop the above "Local Var..." confusing Emacs. -;;; files.el ends here +(ert-deftest files-test-bug-21454 () + "Test for http://debbugs.gnu.org/21454 ." + :expected-result :failed + (let ((input-result + '(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/")) + ("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("//foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo//bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo//bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/")) + ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/")) + ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/")))) + (foo-env (getenv "FOO")) + (bar-env (getenv "BAR"))) + (unwind-protect + (dolist (test input-result) + (let ((foo (nth 0 test)) + (bar (nth 1 test)) + (res (nth 2 test))) + (setenv "FOO" foo) + (if bar + (progn + (setenv "BAR" bar) + (should (equal res (parse-colon-path (getenv "BAR"))))) + (should (equal res (parse-colon-path "$FOO")))))) + (setenv "FOO" foo-env) + (setenv "BAR" bar-env)))) + +(ert-deftest files-test--save-buffers-kill-emacs--confirm-kill-processes () + "Test that `save-buffers-kill-emacs' honors +`confirm-kill-processes'." + (cl-letf* ((yes-or-no-p-prompts nil) + ((symbol-function #'yes-or-no-p) + (lambda (prompt) + (push prompt yes-or-no-p-prompts) + nil)) + (kill-emacs-args nil) + ((symbol-function #'kill-emacs) + (lambda (&optional arg) (push arg kill-emacs-args))) + (process + (make-process + :name "sleep" + :command (list + (expand-file-name invocation-name invocation-directory) + "-batch" "-Q" "-eval" "(sleep-for 1000)"))) + (confirm-kill-processes nil)) + (save-buffers-kill-emacs) + (kill-process process) + (should-not yes-or-no-p-prompts) + (should (equal kill-emacs-args '(nil))))) + +(ert-deftest files-test-read-file-in-~ () + "Test file prompting in directory named '~'. +If we are in a directory named '~', the default value should not +be $HOME." + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _coll &optional _pred _req init _hist def _) + (or def init))) + (dir (make-temp-file "read-file-name-test" t))) + (unwind-protect + (let ((subdir (expand-file-name "./~/" dir))) + (make-directory subdir t) + (with-temp-buffer + (setq default-directory subdir) + (should-not (equal + (expand-file-name (read-file-name "File: ")) + (expand-file-name "~/"))) + ;; Don't overquote either! + (setq default-directory (concat "/:" subdir)) + (should-not (equal + (expand-file-name (read-file-name "File: ")) + (concat "/:/:" subdir))))) + (delete-directory dir 'recursive)))) + +(provide 'files-tests) +;;; files-tests.el ends here diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el new file mode 100644 index 00000000000..8f2c11d391c --- /dev/null +++ b/test/lisp/files-x-tests.el @@ -0,0 +1,297 @@ +;;; files-x-tests.el --- tests for files-x.el. + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Michael Albinus <michael.albinus@gmx.de> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'files-x) + +(defvar files-x-test--criteria1 "my-user@my-remote-host") +(defvar files-x-test--criteria2 + (lambda (identification) + (string-match "another-user@my-remote-host" identification))) +(defvar files-x-test--criteria3 nil) + +(defvar files-x-test--variables1 + '((remote-shell-file-name . "/bin/bash") + (remote-shell-command-switch . "-c") + (remote-shell-interactive-switch . "-i") + (remote-shell-login-switch . "-l"))) +(defvar files-x-test--variables2 + '((remote-shell-file-name . "/bin/ksh"))) +(defvar files-x-test--variables3 + '((remote-null-device . "/dev/null"))) +(defvar files-x-test--variables4 + '((remote-null-device . "null"))) + +(ert-deftest files-x-test-connection-local-set-class-variables () + "Test setting connection-local class variables." + + ;; Declare (CLASS VARIABLES) objects. + (let (connection-local-class-alist connection-local-criteria-alist) + (connection-local-set-class-variables 'remote-bash files-x-test--variables1) + (should + (equal + (connection-local-get-class-variables 'remote-bash) + files-x-test--variables1)) + + (connection-local-set-class-variables 'remote-ksh files-x-test--variables2) + (should + (equal + (connection-local-get-class-variables 'remote-ksh) + files-x-test--variables2)) + + (connection-local-set-class-variables + 'remote-nullfile files-x-test--variables3) + (should + (equal + (connection-local-get-class-variables 'remote-nullfile) + files-x-test--variables3)) + + ;; A redefinition overwrites existing values. + (connection-local-set-class-variables + 'remote-nullfile files-x-test--variables4) + (should + (equal + (connection-local-get-class-variables 'remote-nullfile) + files-x-test--variables4)))) + +(ert-deftest files-x-test-connection-local-set-classes () + "Test setting connection-local classes." + + ;; Declare (CRITERIA CLASSES) objects. + (let (connection-local-class-alist connection-local-criteria-alist) + (connection-local-set-class-variables 'remote-bash files-x-test--variables1) + (connection-local-set-class-variables 'remote-ksh files-x-test--variables2) + (connection-local-set-class-variables + 'remote-nullfile files-x-test--variables3) + + (connection-local-set-classes + files-x-test--criteria1 'remote-bash 'remote-ksh) + (should + (equal + (connection-local-get-classes files-x-test--criteria1) + '(remote-bash remote-ksh))) + + (connection-local-set-classes files-x-test--criteria2 'remote-ksh) + (should + (equal + (connection-local-get-classes files-x-test--criteria2) + '(remote-ksh))) + ;; A further call adds classes. + (connection-local-set-classes files-x-test--criteria2 'remote-nullfile) + (should + (equal + (connection-local-get-classes files-x-test--criteria2) + '(remote-ksh remote-nullfile))) + ;; Adding existing classes doesn't matter. + (connection-local-set-classes + files-x-test--criteria2 'remote-bash 'remote-nullfile) + (should + (equal + (connection-local-get-classes files-x-test--criteria2) + '(remote-ksh remote-nullfile remote-bash))) + + ;; An empty variable list is accepted (but makes no sense). + (connection-local-set-classes files-x-test--criteria3) + (should-not (connection-local-get-classes files-x-test--criteria3)) + + ;; Using a nil criteria also works. Duplicate classes are trashed. + (connection-local-set-classes + files-x-test--criteria3 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash) + (should + (equal + (connection-local-get-classes files-x-test--criteria3) + '(remote-bash remote-ksh))) + + ;; A criteria other than nil, regexp or lambda function is wrong. + (should-error (connection-local-set-classes 'dummy)))) + +(ert-deftest files-x-test-hack-connection-local-variables-apply () + "Test setting connection-local variables." + + (let (connection-local-class-alist connection-local-criteria-alist) + + (connection-local-set-class-variables 'remote-bash files-x-test--variables1) + (connection-local-set-class-variables 'remote-ksh files-x-test--variables2) + (connection-local-set-class-variables + 'remote-nullfile files-x-test--variables3) + + (connection-local-set-classes + files-x-test--criteria1 'remote-bash 'remote-ksh) + (connection-local-set-classes + files-x-test--criteria2 'remote-ksh 'remote-nullfile) + + ;; Apply the variables. + (with-temp-buffer + (let ((enable-connection-local-variables t) + (default-directory "/sudo:my-user@my-remote-host:")) + (should-not connection-local-variables-alist) + (should-not (local-variable-p 'remote-shell-file-name)) + (should-not (boundp 'remote-shell-file-name)) + (hack-connection-local-variables-apply) + ;; All connection-local variables are set. They apply in + ;; reverse order in `connection-local-variables-alist'. The + ;; settings from `remote-ksh' are not contained, because they + ;; declare same variables as in `remote-bash'. + (should + (equal connection-local-variables-alist + (nreverse (copy-tree files-x-test--variables1)))) + ;; The variables exist also as local variables. + (should (local-variable-p 'remote-shell-file-name)) + ;; The proper variable value is set. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash")))) + + ;; The second test case. + (with-temp-buffer + (let ((enable-connection-local-variables t) + (default-directory "/ssh:another-user@my-remote-host:")) + (should-not connection-local-variables-alist) + (should-not (local-variable-p 'remote-shell-file-name)) + (should-not (boundp 'remote-shell-file-name)) + (hack-connection-local-variables-apply) + ;; All connection-local variables are set. They apply in + ;; reverse order in `connection-local-variables-alist'. + (should + (equal connection-local-variables-alist + (append + (nreverse (copy-tree files-x-test--variables3)) + (nreverse (copy-tree files-x-test--variables2))))) + ;; The variables exist also as local variables. + (should (local-variable-p 'remote-shell-file-name)) + ;; The proper variable value is set. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")))) + + ;; The third test case. Both `files-x-test--criteria1' and + ;; `files-x-test--criteria3' apply, but there are no double + ;; entries. + (connection-local-set-classes + files-x-test--criteria3 'remote-bash 'remote-ksh) + (with-temp-buffer + (let ((enable-connection-local-variables t) + (default-directory "/sudo:my-user@my-remote-host:")) + (should-not connection-local-variables-alist) + (should-not (local-variable-p 'remote-shell-file-name)) + (should-not (boundp 'remote-shell-file-name)) + (hack-connection-local-variables-apply) + ;; All connection-local variables are set. They apply in + ;; reverse order in `connection-local-variables-alist'. The + ;; settings from `remote-ksh' are not contained, because they + ;; declare same variables as in `remote-bash'. + (should + (equal connection-local-variables-alist + (nreverse (copy-tree files-x-test--variables1)))) + ;; The variables exist also as local variables. + (should (local-variable-p 'remote-shell-file-name)) + ;; The proper variable value is set. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash")))) + + ;; When `enable-connection-local-variables' is nil, nothing happens. + (with-temp-buffer + (let ((enable-connection-local-variables nil) + (default-directory "/ssh:another-user@my-remote-host:")) + (should-not connection-local-variables-alist) + (should-not (local-variable-p 'remote-shell-file-name)) + (should-not (boundp 'remote-shell-file-name)) + (hack-connection-local-variables-apply) + (should-not connection-local-variables-alist) + (should-not (local-variable-p 'remote-shell-file-name)) + (should-not (boundp 'remote-shell-file-name)))))) + +(ert-deftest files-x-test-with-connection-local-classes () + "Test setting connection-local variables." + + (let (connection-local-class-alist connection-local-criteria-alist) + (connection-local-set-class-variables 'remote-bash files-x-test--variables1) + (connection-local-set-class-variables 'remote-ksh files-x-test--variables2) + (connection-local-set-class-variables + 'remote-nullfile files-x-test--variables3) + (connection-local-set-classes + files-x-test--criteria3 'remote-ksh 'remote-nullfile) + + (with-temp-buffer + (let ((enable-connection-local-variables t) + (default-directory "/sudo:my-user@my-remote-host:")) + (hack-connection-local-variables-apply) + + ;; All connection-local variables are set. They apply in + ;; reverse order in `connection-local-variables-alist'. + (should + (equal connection-local-variables-alist + (append + (nreverse (copy-tree files-x-test--variables3)) + (nreverse (copy-tree files-x-test--variables2))))) + ;; The variables exist also as local variables. + (should (local-variable-p 'remote-shell-file-name)) + (should (local-variable-p 'remote-null-device)) + ;; The proper variable values are set. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")) + (should + (string-equal (symbol-value 'remote-null-device) "/dev/null")) + + ;; A candidate connection-local variable is not bound yet. + (should-not (local-variable-p 'remote-shell-command-switch)) + + ;; Use the macro. + (with-connection-local-classes '(remote-bash remote-ksh) + ;; All connection-local variables are set. They apply in + ;; reverse order in `connection-local-variables-alist'. + ;; This variable keeps only the variables to be set inside + ;; the macro. + (should + (equal connection-local-variables-alist + (nreverse (copy-tree files-x-test--variables1)))) + ;; The variables exist also as local variables. + (should (local-variable-p 'remote-shell-file-name)) + (should (local-variable-p 'remote-shell-command-switch)) + ;; The proper variable values are set. The settings from + ;; `remote-bash' overwrite the same variables as in + ;; `remote-ksh'. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash")) + (should + (string-equal (symbol-value 'remote-shell-command-switch) "-c"))) + + ;; Everything is rewound. The old variable values are reset. + (should + (equal connection-local-variables-alist + (append + (nreverse (copy-tree files-x-test--variables3)) + (nreverse (copy-tree files-x-test--variables2))))) + ;; The variables exist also as local variables. + (should (local-variable-p 'remote-shell-file-name)) + (should (local-variable-p 'remote-null-device)) + ;; The proper variable values are set. The settings from + ;; `remote-ksh' are back. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")) + (should + (string-equal (symbol-value 'remote-null-device) "/dev/null")) + + ;; The variable set temporarily is not unbound, again. + (should-not (local-variable-p 'remote-shell-command-switch)))))) + +(provide 'files-x-tests) +;;; files-x-tests.el ends here diff --git a/test/automated/gnus-tests.el b/test/lisp/gnus/gnus-tests.el index 6801ce69a3e..6801ce69a3e 100644 --- a/test/automated/gnus-tests.el +++ b/test/lisp/gnus/gnus-tests.el diff --git a/test/automated/message-mode-tests.el b/test/lisp/gnus/message-tests.el index 3afa1569f64..13c15e33b27 100644 --- a/test/automated/message-mode-tests.el +++ b/test/lisp/gnus/message-tests.el @@ -55,6 +55,49 @@ (point))))) (set-buffer-modified-p nil)))) + +(ert-deftest message-strip-subject-trailing-was () + (cl-letf (((symbol-function 'message-talkative-question) nil)) + (with-temp-buffer + (let ((no-was "Re: Foo ") + (with-was "Re: Foo \t (was: Bar ) ") + (stripped-was "Re: Foo") + reply) + + ;; Test unconditional stripping + (setq-local message-subject-trailing-was-query t) + (should (string= no-was (message-strip-subject-trailing-was no-was))) + (should (string= stripped-was + (message-strip-subject-trailing-was with-was))) + + ;; Test asking + (setq-local message-subject-trailing-was-query 'ask) + (fset 'message-talkative-question + (lambda (_ question show text) + (should (string= "Strip `(was: <old subject>)' in subject? " + question)) + (should show) + (should (string-match + (concat + "Strip `(was: <old subject>)' in subject " + "and use the new one instead\\?\n\n" + "Current subject is: \"\\(.*\\)\"\n\n" + "New subject would be: \"\\(.*\\)\"\n\n" + "See the variable " + "`message-subject-trailing-was-query' " + "to get rid of this query.") + text)) + (should (string= (match-string 1 text) with-was)) + (should (string= (match-string 2 text) stripped-was)) + reply)) + (message-strip-subject-trailing-was with-was) + (should (string= with-was + (message-strip-subject-trailing-was with-was))) + (setq reply t) + (should (string= stripped-was + (message-strip-subject-trailing-was with-was))))))) + + (provide 'message-mode-tests) ;;; message-mode-tests.el ends here diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el new file mode 100644 index 00000000000..ba0d8ed8e38 --- /dev/null +++ b/test/lisp/help-fns-tests.el @@ -0,0 +1,121 @@ +;;; help-fns.el --- tests for help-fns.el + +;; Copyright (C) 2014-2016 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) + +(autoload 'help-fns-test--macro "help-fns" nil nil t) + + +;;; Several tests for describe-function + +(defun help-fns-tests--describe-function (func) + "Helper function for `describe-function' tests. +FUNC is the function to describe, a symbol. +Return first line of the output of (describe-function-1 FUNC)." + (let ((string (with-output-to-string + (describe-function-1 func)))) + (string-match "\\(.+\\)\n" string) + (match-string-no-properties 1 string))) + +(ert-deftest help-fns-test-bug17410 () + "Test for http://debbugs.gnu.org/17410 ." + (let ((regexp "autoloaded Lisp macro") + (result (help-fns-tests--describe-function 'help-fns-test--macro))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-built-in () + (let ((regexp "a built-in function in .C source code") + (result (help-fns-tests--describe-function 'mapcar))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-interactive-built-in () + (let ((regexp "an interactive built-in function in .C source code") + (result (help-fns-tests--describe-function 're-search-forward))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-lisp-macro () + (let ((regexp "a Lisp macro in .subr\.el") + (result (help-fns-tests--describe-function 'when))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-lisp-defun () + (let ((regexp "a compiled Lisp function in .subr\.el") + (result (help-fns-tests--describe-function 'last))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-lisp-defsubst () + (let ((regexp "a compiled Lisp function in .subr\.el") + (result (help-fns-tests--describe-function 'posn-window))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-alias-to-defun () + (let ((regexp "an alias for .set-file-modes. in .subr\.el") + (result (help-fns-tests--describe-function 'chmod))) + (should (string-match regexp result)))) + +(ert-deftest help-fns-test-bug23887 () + "Test for http://debbugs.gnu.org/23887 ." + (let ((regexp "an alias for .re-search-forward. in .subr\.el") + (result (help-fns-tests--describe-function 'search-forward-regexp))) + (should (string-match regexp result)))) + + +;;; Test describe-function over functions with funny names +(defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x) + "A function with a funny name. + +\(fn XYZZY)" + x) + +(defun defgh\\\[universal-argument\]b\`c\'d\\e\"f (x) + "Another function with a funny name." + x) + +(ert-deftest help-fns-test-funny-names () + "Test for help with functions with funny names." + (describe-function 'abc\\\[universal-argument\]b\`c\'d\\e\"f) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward + "(abc\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f XYZZY)"))) + (describe-function 'defgh\\\[universal-argument\]b\`c\'d\\e\"f) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward + "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)")))) + + +;;; Test for describe-symbol +(ert-deftest help-fns-test-describe-symbol () + "Test the `describe-symbol' function." + ;; 'describe-symbol' would originally signal an error for + ;; 'font-lock-comment-face'. + (describe-symbol 'font-lock-comment-face) + (with-current-buffer "*Help*" + (should (> (point-max) 1)) + (goto-char (point-min)) + (should (looking-at "^font-lock-comment-face is ")))) + +;;; help-fns.el ends here diff --git a/test/lisp/htmlfontify-tests.el b/test/lisp/htmlfontify-tests.el new file mode 100644 index 00000000000..012e170f4d6 --- /dev/null +++ b/test/lisp/htmlfontify-tests.el @@ -0,0 +1,34 @@ +;;; htmlfontify-tests.el --- Test suite. -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: +(require 'ert) +(require 'htmlfontify) + +(ert-deftest htmlfontify-autoload () + "Tests to see whether reftex-auc has been autoloaded" + (should + (fboundp 'htmlfontify-load-rgb-file)) + (should + (autoloadp + (symbol-function + 'htmlfontify-load-rgb-file)))) + +(provide 'htmlfontify-tests) +;; htmlfontify-tests.el ends here diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el new file mode 100644 index 00000000000..40760abd96a --- /dev/null +++ b/test/lisp/ibuffer-tests.el @@ -0,0 +1,807 @@ +;;; ibuffer-tests.el --- Test suite. -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: +(require 'ert) +(require 'ibuffer) +(eval-when-compile + (require 'ibuf-macs)) + +(ert-deftest ibuffer-autoload () + "Tests to see whether ibuffer has been autoloaded" + (skip-unless (not (featurep 'ibuf-ext))) + (should + (fboundp 'ibuffer-mark-unsaved-buffers)) + (should + (autoloadp + (symbol-function + 'ibuffer-mark-unsaved-buffers)))) + +(ert-deftest ibuffer-test-Bug24997 () + "Test for http://debbugs.gnu.org/24997 ." + (ibuffer) + (let ((orig ibuffer-filtering-qualifiers)) + (unwind-protect + (progn + (setq ibuffer-filtering-qualifiers + '((size-gt . 10) + (used-mode . lisp-interaction-mode))) + (ibuffer-update nil t) + (ignore-errors (ibuffer-decompose-filter)) + (should (cdr ibuffer-filtering-qualifiers))) + (setq ibuffer-filtering-qualifiers orig) + (ibuffer-update nil t)))) + +(ert-deftest ibuffer-test-Bug25000 () + "Test for http://debbugs.gnu.org/25000 ." + (let ((case-fold-search t) + (buf1 (generate-new-buffer "ibuffer-test-Bug25000-buf1")) + (buf2 (generate-new-buffer "ibuffer-test-Bug25000-buf2"))) + (ibuffer) + (unwind-protect + (ibuffer-save-marks + (ibuffer-unmark-all-marks) + (ibuffer-mark-by-name-regexp (buffer-name buf1)) + (ibuffer-change-marks ibuffer-marked-char ?L) + (ibuffer-mark-by-name-regexp (buffer-name buf2)) + (ibuffer-change-marks ibuffer-marked-char ?l) + (should-not (cdr (ibuffer-buffer-names-with-mark ?l)))) + (mapc (lambda (buf) (when (buffer-live-p buf) + (kill-buffer buf))) (list buf1 buf2))))) + +(ert-deftest ibuffer-save-filters () + "Tests that `ibuffer-save-filters' saves in the proper format." + (skip-unless (featurep 'ibuf-ext)) + (let ((ibuffer-save-with-custom nil) + (ibuffer-saved-filters nil) + (test1 '((mode . org-mode) + (or (size-gt . 10000) + (and (not (starred-name)) + (directory . "\<org\>"))))) + (test2 '((or (mode . emacs-lisp-mode) (file-extension . "elc?") + (and (starred-name) (name . "elisp")) + (mode . lisp-interaction-mode)))) + (test3 '((size-lt . 100) (derived-mode . prog-mode) + (or (filename . "scratch") + (filename . "bonz") + (filename . "temp"))))) + (ibuffer-save-filters "test1" test1) + (should (equal (car ibuffer-saved-filters) (cons "test1" test1))) + (ibuffer-save-filters "test2" test2) + (should (equal (car ibuffer-saved-filters) (cons "test2" test2))) + (should (equal (cadr ibuffer-saved-filters) (cons "test1" test1))) + (ibuffer-save-filters "test3" test3) + (should (equal (car ibuffer-saved-filters) (cons "test3" test3))) + (should (equal (cadr ibuffer-saved-filters) (cons "test2" test2))) + (should (equal (car (cddr ibuffer-saved-filters)) (cons "test1" test1))) + (should (equal (cdr (assoc "test1" ibuffer-saved-filters)) test1)) + (should (equal (cdr (assoc "test2" ibuffer-saved-filters)) test2)) + (should (equal (cdr (assoc "test3" ibuffer-saved-filters)) test3)))) + +(ert-deftest ibuffer-test-Bug25058 () + "Test for http://debbugs.gnu.org/25058 ." + (ibuffer) + (let ((orig-filters ibuffer-saved-filter-groups) + (tmp-filters '(("saved-filters" + ("Shell" + (used-mode . shell-mode)) + ("Elisp" + (or + (used-mode . emacs-lisp-mode) + (used-mode . lisp-interaction-mode))) + ("Dired" + (used-mode . dired-mode)) + ("Info" + (or + (used-mode . help-mode) + (used-mode . debugger-mode) + (used-mode . Custom-mode) + (used-mode . completion-list-mode) + (name . "\\`[*]Messages[*]\\'"))))))) + (unwind-protect + (progn + (setq ibuffer-saved-filter-groups tmp-filters) + (ibuffer-switch-to-saved-filter-groups "saved-filters") + (ibuffer-decompose-filter-group "Elisp") + (ibuffer-filter-disable) + (ibuffer-switch-to-saved-filter-groups "saved-filters") + (should (assoc "Elisp" (cdar ibuffer-saved-filter-groups)))) + (setq ibuffer-saved-filter-groups orig-filters) + (ibuffer-awhen (get-buffer "*Ibuffer*") + (and (buffer-live-p it) (kill-buffer it)))))) + + +(ert-deftest ibuffer-test-Bug25042 () + "Test for http://debbugs.gnu.org/25042 ." + (ibuffer) + (let ((filters ibuffer-filtering-qualifiers)) + (unwind-protect + (progn + (ignore-errors ; Mistyped `match-string' instead of `string-match'. + (setq ibuffer-filtering-qualifiers nil) + (ibuffer-filter-by-predicate '(match-string "foo" (buffer-name)))) + (should-not ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers filters)))) + +;; Test Filter Inclusion +(let* (test-buffer-list ; accumulated buffers to clean up + ;; Utility functions without polluting the environment + (set-buffer-mode + (lambda (buffer mode) + "Set BUFFER's major mode to MODE, a mode function, or fundamental." + (with-current-buffer buffer + (funcall (or mode #'fundamental-mode))))) + (set-buffer-contents + (lambda (buffer size include-content) + "Add exactly SIZE bytes to BUFFER, including INCLUDE-CONTENT." + (when (or size include-content) + (let* ((unit "\n") + (chunk "ccccccccccccccccccccccccccccccc\n") + (chunk-size (length chunk)) + (size (if (and size include-content (stringp include-content)) + (- size (length include-content)) + size))) + (unless (or (null size) (> size 0)) + (error "size argument must be nil or positive")) + (with-current-buffer buffer + (when include-content + (insert include-content)) + (when size + (dotimes (_ (floor size chunk-size)) + (insert chunk)) + (dotimes (_ (mod size chunk-size)) + (insert unit))) + ;; prevent query on cleanup + (set-buffer-modified-p nil)))))) + (create-file-buffer + (lambda (prefix &rest args-plist) + "Create a file and buffer with designated properties. + PREFIX is a string giving the beginning of the name, and ARGS-PLIST + is a series of keyword-value pairs, with allowed keywords + :suffix STRING, :size NUMBER, :mode MODE-FUNC, :include-content STRING. + Returns the created buffer." + (let* ((suffix (plist-get args-plist :suffix)) + (size (plist-get args-plist :size)) + (include (plist-get args-plist :include-content)) + (mode (plist-get args-plist :mode)) + (file (make-temp-file prefix nil suffix)) + (buf (find-file-noselect file t))) + (push buf test-buffer-list) ; record for cleanup + (funcall set-buffer-mode buf mode) + (funcall set-buffer-contents buf size include) + buf))) + (create-non-file-buffer + (lambda (prefix &rest args-plist) + "Create a non-file and buffer with designated properties. + PREFIX is a string giving the beginning of the name, and ARGS-PLIST + is a series of keyword-value pairs, with allowed keywords + :size NUMBER, :mode MODE-FUNC, :include-content STRING. + Returns the created buffer." + (let* ((size (plist-get args-plist :size)) + (include (plist-get args-plist :include-content)) + (mode (plist-get args-plist :mode)) + (buf (generate-new-buffer prefix))) + (push buf test-buffer-list) ; record for cleanup + (funcall set-buffer-mode buf mode) + (funcall set-buffer-contents buf size include) + buf))) + (clean-up + (lambda () + "Restore all emacs state modified during the tests" + (while test-buffer-list ; created temporary buffers + (let ((buf (pop test-buffer-list))) + (with-current-buffer buf (bury-buffer)) ; ensure not selected + (kill-buffer buf)))))) + ;; Tests + (ert-deftest ibuffer-filter-inclusion-1 () + "Tests inclusion using basic filter combinators with a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-file-buffer "ibuf-test-1" :size 100 + :include-content "One ring to rule them all\n"))) + (should (ibuffer-included-in-filters-p buf '((size-gt . 99)))) + (should (ibuffer-included-in-filters-p buf '((size-lt . 101)))) + (should (ibuffer-included-in-filters-p + buf '((mode . fundamental-mode)))) + (should (ibuffer-included-in-filters-p + buf '((content . "ring to rule them all")))) + (should (ibuffer-included-in-filters-p + buf '((and (content . "ring to rule them all"))))) + (should (ibuffer-included-in-filters-p + buf '((and (and (content . "ring to rule them all")))))) + (should (ibuffer-included-in-filters-p + buf '((and (and (and (content . "ring to rule them all"))))))) + (should (ibuffer-included-in-filters-p + buf '((or (content . "ring to rule them all"))))) + (should (ibuffer-included-in-filters-p + buf '((not (not (content . "ring to rule them all")))))) + (should (ibuffer-included-in-filters-p + buf '((and (size-gt . 99) + (content . "ring to rule them all") + (mode . fundamental-mode) + (basename . "\\`ibuf-test-1"))))) + (should (ibuffer-included-in-filters-p + buf '((not (or (not (size-gt . 99)) + (not (content . "ring to rule them all")) + (not (mode . fundamental-mode)) + (not (basename . "\\`ibuf-test-1"))))))) + (should (ibuffer-included-in-filters-p + buf '((and (or (size-gt . 99) (size-lt . 10)) + (and (content . "ring.*all") + (content . "rule") + (content . "them all") + (content . "One")) + (not (mode . text-mode)) + (basename . "\\`ibuf-test-1")))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-2 () + "Tests inclusion of basic filters in combination on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-file-buffer "ibuf-test-2" :size 200 + :mode #'text-mode + :include-content "and in the darkness find them\n"))) + (should (ibuffer-included-in-filters-p buf '((size-gt . 199)))) + (should (ibuffer-included-in-filters-p buf '((size-lt . 201)))) + (should (ibuffer-included-in-filters-p buf '((not size-gt . 200)))) + (should (ibuffer-included-in-filters-p buf '((not (size-gt . 200))))) + (should (ibuffer-included-in-filters-p + buf '((and (size-gt . 199) (size-lt . 201))))) + (should (ibuffer-included-in-filters-p + buf '((or (size-gt . 199) (size-gt . 201))))) + (should (ibuffer-included-in-filters-p + buf '((or (size-gt . 201) (size-gt . 199))))) + (should (ibuffer-included-in-filters-p + buf '((size-gt . 199) (mode . text-mode) + (content . "darkness find them")))) + (should (ibuffer-included-in-filters-p + buf '((and (size-gt . 199) (mode . text-mode) + (content . "darkness find them"))))) + (should (ibuffer-included-in-filters-p + buf '((not (or (not (size-gt . 199)) (not (mode . text-mode)) + (not (content . "darkness find them"))))))) + (should (ibuffer-included-in-filters-p + buf '((or (size-gt . 200) (content . "darkness find them") + (derived-mode . emacs-lisp-mode))))) + (should-not (ibuffer-included-in-filters-p + buf '((or (size-gt . 200) (content . "rule them all") + (derived-mode . emacs-lisp-mode)))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-3 () + "Tests inclusion with filename filters on specified buffers." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let* ((bufA + (funcall create-file-buffer "ibuf-test-3.a" :size 50 + :mode #'text-mode + :include-content "...but a multitude of drops?\n")) + (bufB + (funcall create-non-file-buffer "ibuf-test-3.b" :size 50 + :mode #'text-mode + :include-content "...but a multitude of drops?\n")) + (dirA (with-current-buffer bufA default-directory)) + (dirB (with-current-buffer bufB default-directory))) + (should (ibuffer-included-in-filters-p + bufA '((basename . "ibuf-test-3")))) + (should (ibuffer-included-in-filters-p + bufA '((basename . "test-3\\.a")))) + (should (ibuffer-included-in-filters-p + bufA '((file-extension . "a")))) + (should (ibuffer-included-in-filters-p + bufA (list (cons 'directory dirA)))) + (should-not (ibuffer-included-in-filters-p + bufB '((basename . "ibuf-test-3")))) + (should-not (ibuffer-included-in-filters-p + bufB '((file-extension . "b")))) + (should (ibuffer-included-in-filters-p + bufB (list (cons 'directory dirB)))) + (should (ibuffer-included-in-filters-p + bufA '((name . "ibuf-test-3")))) + (should (ibuffer-included-in-filters-p + bufB '((name . "ibuf-test-3"))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-4 () + "Tests inclusion with various filters on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-file-buffer "ibuf-test-4" + :mode #'emacs-lisp-mode :suffix ".el" + :include-content "(message \"--%s--\" 'emacs-rocks)\n"))) + (should (ibuffer-included-in-filters-p + buf '((file-extension . "el")))) + (should (ibuffer-included-in-filters-p + buf '((derived-mode . prog-mode)))) + (should (ibuffer-included-in-filters-p + buf '((used-mode . emacs-lisp-mode)))) + (should (ibuffer-included-in-filters-p + buf '((mode . emacs-lisp-mode)))) + (with-current-buffer buf (set-buffer-modified-p t)) + (should (ibuffer-included-in-filters-p buf '((modified)))) + (with-current-buffer buf (set-buffer-modified-p nil)) + (should (ibuffer-included-in-filters-p buf '((not modified)))) + (should (ibuffer-included-in-filters-p + buf '((and (file-extension . "el") + (derived-mode . prog-mode) + (not modified))))) + (should (ibuffer-included-in-filters-p + buf '((or (file-extension . "tex") + (derived-mode . prog-mode) + (modified))))) + (should (ibuffer-included-in-filters-p + buf '((file-extension . "el") + (derived-mode . prog-mode) + (not modified))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-5 () + "Tests inclusion with various filters on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-non-file-buffer "ibuf-test-5.el" + :mode #'emacs-lisp-mode + :include-content + "(message \"--%s--\" \"It really does!\")\n"))) + (should-not (ibuffer-included-in-filters-p + buf '((file-extension . "el")))) + (should (ibuffer-included-in-filters-p + buf '((size-gt . 18)))) + (should (ibuffer-included-in-filters-p + buf '((predicate . (lambda () + (> (- (point-max) (point-min)) 18)))))) + (should (ibuffer-included-in-filters-p + buf '((and (mode . emacs-lisp-mode) + (or (starred-name) + (size-gt . 18)) + (and (not (size-gt . 100)) + (content . "[Ii]t *really does!") + (or (name . "test-5") + (not (filename . "test-5"))))))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-6 () + "Tests inclusion using saved filters and DeMorgan's laws." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-non-file-buffer "*ibuf-test-6*" :size 65 + :mode #'text-mode)) + (buf2 + (funcall create-file-buffer "ibuf-test-6a" :suffix ".html" + :mode #'html-mode + :include-content + "<HTML><BODY><H1>Hello, World!</H1></BODY></HTML>"))) + (should (ibuffer-included-in-filters-p buf '((starred-name)))) + (should-not (ibuffer-included-in-filters-p + buf '((saved . "text document")))) + (should (ibuffer-included-in-filters-p buf2 '((saved . "web")))) + (should (ibuffer-included-in-filters-p + buf2 '((not (and (not (derived-mode . sgml-mode)) + (not (derived-mode . css-mode)) + (not (mode . javascript-mode)) + (not (mode . js2-mode)) + (not (mode . scss-mode)) + (not (derived-mode . haml-mode)) + (not (mode . sass-mode))))))) + (should (ibuffer-included-in-filters-p + buf '((and (starred-name) + (or (size-gt . 50) (filename . "foo")))))) + (should (ibuffer-included-in-filters-p + buf '((not (or (not starred-name) + (and (size-lt . 51) + (not (filename . "foo"))))))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-7 () + "Tests inclusion with various filters on a single buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((buf + (funcall create-non-file-buffer "ibuf-test-7" + :mode #'artist-mode))) + (should (ibuffer-included-in-filters-p + buf '((not (starred-name))))) + (should (ibuffer-included-in-filters-p + buf '((not starred-name)))) + (should (ibuffer-included-in-filters-p + buf '((not (not (not starred-name)))))) + (should (ibuffer-included-in-filters-p + buf '((not (modified))))) + (should (ibuffer-included-in-filters-p + buf '((not modified)))) + (should (ibuffer-included-in-filters-p + buf '((not (not (not modified))))))) + (funcall clean-up))) + + (ert-deftest ibuffer-filter-inclusion-8 () + "Tests inclusion with various filters." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((bufA + (funcall create-non-file-buffer "ibuf-test-8a" + :mode #'artist-mode)) + (bufB (funcall create-non-file-buffer "*ibuf-test-8b*" :size 32)) + (bufC (funcall create-file-buffer "ibuf-test8c" :suffix "*" + :size 64)) + (bufD (funcall create-file-buffer "*ibuf-test8d" :size 128)) + (bufE (funcall create-file-buffer "*ibuf-test8e" :suffix "*<2>" + :size 16)) + (bufF (and (funcall create-non-file-buffer "*ibuf-test8f*") + (funcall create-non-file-buffer "*ibuf-test8f*" + :size 8)))) + (with-current-buffer bufA (set-buffer-modified-p t)) + (should (ibuffer-included-in-filters-p + bufA '((and (not starred-name) + (modified) + (name . "test-8") + (not (size-gt . 100)) + (mode . picture-mode))))) + (with-current-buffer bufA (set-buffer-modified-p nil)) + (should-not (ibuffer-included-in-filters-p + bufA '((or (starred-name) (visiting-file) (modified))))) + (should (ibuffer-included-in-filters-p + bufB '((and (starred-name) + (name . "test.*8b") + (size-gt . 31) + (not visiting-file))))) + (should (ibuffer-included-in-filters-p + bufC '((and (not (starred-name)) + (visiting-file) + (name . "8c[^*]*\\*") + (size-lt . 65))))) + (should (ibuffer-included-in-filters-p + bufD '((and (not (starred-name)) + (visiting-file) + (name . "\\`\\*.*test8d") + (size-lt . 129) + (size-gt . 127))))) + (should (ibuffer-included-in-filters-p + bufE '((and (starred-name) + (visiting-file) + (name . "8e.*?\\*<[[:digit:]]+>") + (size-gt . 10))))) + (should (ibuffer-included-in-filters-p + bufF '((and (starred-name) + (not (visiting-file)) + (name . "8f\\*<[[:digit:]]>") + (size-lt . 10)))))) + (funcall clean-up)))) + +;; Test Filter Combination and Decomposition +(let* (ibuffer-to-kill ; if non-nil, kill this buffer at cleanup + (ibuffer-already 'check) ; existing ibuffer buffer to use but not kill + ;; Utility functions without polluting the environment + (get-test-ibuffer + (lambda () + "Returns a test ibuffer-mode buffer, creating one if necessary. + If a new buffer is created, it is named \"*Test-Ibuffer*\" and is + saved to `ibuffer-to-kill' for later cleanup." + (when (eq ibuffer-already 'check) + (setq ibuffer-already + (catch 'found-buf + (dolist (buf (buffer-list) nil) + (when (with-current-buffer buf + (derived-mode-p 'ibuffer-mode)) + (throw 'found-buf buf)))))) + (or ibuffer-already + ibuffer-to-kill + (let ((test-ibuf-name "*Test-Ibuffer*")) + (ibuffer nil test-ibuf-name nil t) + (setq ibuffer-to-kill (get-buffer test-ibuf-name)))))) + (clean-up + (lambda () + "Restore all emacs state modified during the tests" + (when ibuffer-to-kill ; created ibuffer + (with-current-buffer ibuffer-to-kill + (set-buffer-modified-p nil) + (bury-buffer)) + (kill-buffer ibuffer-to-kill) + (setq ibuffer-to-kill nil)) + (when (and ibuffer-already (not (eq ibuffer-already 'check))) + ;; restore existing ibuffer state + (ibuffer-update nil t))))) + ;; Tests + (ert-deftest ibuffer-decompose-filter () + "Tests `ibuffer-decompose-filter' for and, or, not, and saved." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((ibuf (funcall get-test-ibuffer))) + (with-current-buffer ibuf + (let ((ibuffer-filtering-qualifiers nil) + (ibuffer-filter-groups nil) + (filters '((size-gt . 100) (not (starred-name)) + (name . "foo")))) + (progn + (push (cons 'or filters) ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal filters ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (progn + (push (cons 'and filters) ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal filters ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (progn + (push (list 'not (car filters)) ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal (list (car filters)) + ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (progn + (push (cons 'not (car filters)) ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal (list (car filters)) + ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (let ((gnus (assoc "gnus" ibuffer-saved-filters))) + (push '(saved . "gnus") ibuffer-filtering-qualifiers) + (ibuffer-decompose-filter) + (should (equal (cdr gnus) ibuffer-filtering-qualifiers)) + (ibuffer-decompose-filter) + (should (equal (cdr (cadr gnus)) ibuffer-filtering-qualifiers)) + (setq ibuffer-filtering-qualifiers nil)) + (when (not (assoc "__unknown__" ibuffer-saved-filters)) + (push '(saved . "__uknown__") ibuffer-filtering-qualifiers) + (should-error (ibuffer-decompose-filter) :type 'error) + (setq ibuffer-filtering-qualifiers nil)) + (progn + (push (car filters) ibuffer-filtering-qualifiers) + (should-error (ibuffer-decompose-filter) :type 'error) + (setq ibuffer-filtering-qualifiers nil))))) + (funcall clean-up))) + + (ert-deftest ibuffer-and-filter () + "Tests `ibuffer-and-filter' in an Ibuffer buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((ibuf (funcall get-test-ibuffer))) + (with-current-buffer ibuf + (let ((ibuffer-filtering-qualifiers nil) + (ibuffer-filter-groups nil) + (filters [(size-gt . 100) (not (starred-name)) + (filename . "A") (mode . text-mode)])) + (should-error (ibuffer-and-filter) :type 'error) + (progn + (push (aref filters 1) ibuffer-filtering-qualifiers) + (should-error (ibuffer-and-filter) :type 'error)) + (should (progn + (push (aref filters 0) ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and (aref filters 0) (aref filters 1)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (should (progn + (ibuffer-and-filter 'decompose) + (and (equal (aref filters 0) + (pop ibuffer-filtering-qualifiers)) + (equal (aref filters 1) + (pop ibuffer-filtering-qualifiers)) + (null ibuffer-filtering-qualifiers)))) + (should (progn + (push (list 'and (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'and (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and (aref filters 0) (aref filters 1) + (aref filters 2) (aref filters 3)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'or (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'and (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and (aref filters 0) (aref filters 1) + (list 'or (aref filters 2) + (aref filters 3))) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'and (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'or (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and (list 'or (aref filters 0) + (aref filters 1)) + (aref filters 2) (aref filters 3)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'or (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'or (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-and-filter) + (and (equal (list 'and + (list 'or (aref filters 0) + (aref filters 1)) + (list 'or (aref filters 2) + (aref filters 3))) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers)))))))) + (funcall clean-up))) + + (ert-deftest ibuffer-or-filter () + "Tests `ibuffer-or-filter' in an Ibuffer buffer." + (skip-unless (featurep 'ibuf-ext)) + (unwind-protect + (let ((ibuf (funcall get-test-ibuffer))) + (with-current-buffer ibuf + (let ((ibuffer-filtering-qualifiers nil) + (ibuffer-filter-groups nil) + (filters [(size-gt . 100) (not (starred-name)) + (filename . "A") (mode . text-mode)])) + (should-error (ibuffer-or-filter) :type 'error) + (progn + (push (aref filters 1) ibuffer-filtering-qualifiers) + (should-error (ibuffer-or-filter) :type 'error)) + (should (progn + (push (aref filters 0) ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or (aref filters 0) (aref filters 1)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (should (progn + (ibuffer-or-filter 'decompose) + (and (equal (aref filters 0) + (pop ibuffer-filtering-qualifiers)) + (equal (aref filters 1) + (pop ibuffer-filtering-qualifiers)) + (null ibuffer-filtering-qualifiers)))) + (should (progn + (push (list 'or (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'or (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or (aref filters 0) (aref filters 1) + (aref filters 2) (aref filters 3)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'and (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'or (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or (aref filters 0) (aref filters 1) + (list 'and (aref filters 2) + (aref filters 3))) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'or (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'and (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or (list 'and (aref filters 0) + (aref filters 1)) + (aref filters 2) (aref filters 3)) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers))))) + (pop ibuffer-filtering-qualifiers) + (should (progn + (push (list 'and (aref filters 2) (aref filters 3)) + ibuffer-filtering-qualifiers) + (push (list 'and (aref filters 0) (aref filters 1)) + ibuffer-filtering-qualifiers) + (ibuffer-or-filter) + (and (equal (list 'or + (list 'and (aref filters 0) + (aref filters 1)) + (list 'and (aref filters 2) + (aref filters 3))) + (car ibuffer-filtering-qualifiers)) + (null (cdr ibuffer-filtering-qualifiers)))))))) + (funcall clean-up)))) + +(ert-deftest ibuffer-format-qualifier () + "Tests string recommendation of filter from `ibuffer-format-qualifier'." + (skip-unless (featurep 'ibuf-ext)) + (let ((test1 '(mode . org-mode)) + (test2 '(size-lt . 100)) + (test3 '(derived-mode . prog-mode)) + (test4 '(or (size-gt . 10000) + (and (not (starred-name)) + (directory . "\\<org\\>")))) + (test5 '(or (filename . "scratch") + (filename . "bonz") + (filename . "temp"))) + (test6 '(or (mode . emacs-lisp-mode) (file-extension . "elc?") + (and (starred-name) (name . "elisp")) + (mode . lisp-interaction-mode))) + (description (lambda (q) + (cadr (assq q ibuffer-filtering-alist)))) + (tag (lambda (&rest args ) + (concat " [" (apply #'concat args) "]")))) + (should (equal (ibuffer-format-qualifier test1) + (funcall tag (funcall description 'mode) + ": " "org-mode"))) + (should (equal (ibuffer-format-qualifier test2) + (funcall tag (funcall description 'size-lt) + ": " "100"))) + (should (equal (ibuffer-format-qualifier test3) + (funcall tag (funcall description 'derived-mode) + ": " "prog-mode"))) + (should (equal (ibuffer-format-qualifier test4) + (funcall tag "OR" + (funcall tag (funcall description 'size-gt) + ": " (format "%s" 10000)) + (funcall tag "AND" + (funcall tag "NOT" + (funcall tag + (funcall description + 'starred-name) + ": " "nil")) + (funcall tag + (funcall description 'directory) + ": " "\\<org\\>"))))) + (should (equal (ibuffer-format-qualifier test5) + (funcall tag "OR" + (funcall tag (funcall description 'filename) + ": " "scratch") + (funcall tag (funcall description 'filename) + ": " "bonz") + (funcall tag (funcall description 'filename) + ": " "temp")))) + (should (equal (ibuffer-format-qualifier test6) + (funcall tag "OR" + (funcall tag (funcall description 'mode) + ": " "emacs-lisp-mode") + (funcall tag (funcall description 'file-extension) + ": " "elc?") + (funcall tag "AND" + (funcall tag + (funcall description 'starred-name) + ": " "nil") + (funcall tag + (funcall description 'name) + ": " "elisp")) + (funcall tag (funcall description 'mode) + ": " "lisp-interaction-mode")))))) + +(ert-deftest ibuffer-unary-operand () + "Tests `ibuffer-unary-operand': (not cell) or (not . cell) -> cell." + (skip-unless (featurep 'ibuf-ext)) + (should (equal (ibuffer-unary-operand '(not . (mode "foo"))) + '(mode "foo"))) + (should (equal (ibuffer-unary-operand '(not (mode "foo"))) + '(mode "foo"))) + (should (equal (ibuffer-unary-operand '(not "cdr")) + '("cdr"))) + (should (equal (ibuffer-unary-operand '(not)) nil)) + (should (equal (ibuffer-unary-operand '(not . a)) 'a))) + +(provide 'ibuffer-tests) +;; ibuffer-tests.el ends here diff --git a/test/automated/imenu-test.el b/test/lisp/imenu-tests.el index b6e0f604d0e..b6e0f604d0e 100644 --- a/test/automated/imenu-test.el +++ b/test/lisp/imenu-tests.el diff --git a/test/automated/info-xref.el b/test/lisp/info-xref-tests.el index bc3115042bc..bc3115042bc 100644 --- a/test/automated/info-xref.el +++ b/test/lisp/info-xref-tests.el diff --git a/test/automated/mule-util.el b/test/lisp/international/mule-util-tests.el index 9846aa13295..9846aa13295 100644 --- a/test/automated/mule-util.el +++ b/test/lisp/international/mule-util-tests.el diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el new file mode 100644 index 00000000000..42cf805b778 --- /dev/null +++ b/test/lisp/international/ucs-normalize-tests.el @@ -0,0 +1,277 @@ +;;; ucs-normalize --- tests for international/ucs-normalize.el -*- lexical-binding: t -*- + +;; Copyright (C) 2002-2016 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; The Part1 test takes a long time because it goes over the whole +;; unicode character set; you should build Emacs with optimization +;; enabled before running it. +;; +;; If there are lines marked as failing (see +;; `ucs-normalize-tests--failing-lines-part1' and +;; `ucs-normalize-tests--failing-lines-part2'), they may need to be +;; adjusted when NormalizationTest.txt is updated. To get a list of +;; currently failing lines, set those 2 variables to nil, run the +;; tests, and inspect the values of +;; `ucs-normalize-tests--part1-rule1-failed-lines' and +;; `ucs-normalize-tests--part1-rule2-failed-chars', respectively. + +;;; Code: + +(eval-when-compile (require 'cl-lib)) +(require 'ert) +(require 'ucs-normalize) + +(defconst ucs-normalize-test-data-file + (expand-file-name "admin/unidata/NormalizationTest.txt" source-directory)) + +(defun ucs-normalize-tests--parse-column () + (let ((chars nil) + (term nil)) + (while (and (not (equal term ";")) + (looking-at "\\([[:xdigit:]]\\{4,6\\}\\)\\([; ]\\)")) + (let ((code-point (match-string 1))) + (setq term (match-string 2)) + (goto-char (match-end 0)) + (push (string-to-number code-point 16) chars))) + (nreverse chars))) + +(defmacro ucs-normalize-tests--normalize (norm str) + "Like `ucs-normalize-string' but reuse current buffer for efficiency. +And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity." + (let ((norm-alist '((NFC . ucs-normalize-NFC-region) + (NFD . ucs-normalize-NFD-region) + (NFKC . ucs-normalize-NFKC-region) + (NFKD . ucs-normalize-NFKD-region)))) + `(save-restriction + (narrow-to-region (point) (point)) + (insert ,str) + (funcall #',(cdr (assq norm norm-alist)) (point-min) (point-max)) + (delete-and-extract-region (point-min) (point-max))))) + +(defvar ucs-normalize-tests--chars-part1 nil) + +(defun ucs-normalize-tests--invariants-hold-p (&rest columns) + "Check 1st conformance rule. +The following invariants must be true for all conformant implementations..." + (when ucs-normalize-tests--chars-part1 + ;; See `ucs-normalize-tests--invariants-rule2-hold-p'. + (aset ucs-normalize-tests--chars-part1 + (caar columns) 1)) + (cl-destructuring-bind (source nfc nfd nfkc nfkd) + (mapcar (lambda (c) (apply #'string c)) columns) + (and + ;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3) + (equal nfc (ucs-normalize-tests--normalize NFC source)) + (equal nfc (ucs-normalize-tests--normalize NFC nfc)) + (equal nfc (ucs-normalize-tests--normalize NFC nfd)) + ;; c4 == toNFC(c4) == toNFC(c5) + (equal nfkc (ucs-normalize-tests--normalize NFC nfkc)) + (equal nfkc (ucs-normalize-tests--normalize NFC nfkd)) + + ;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3) + (equal nfd (ucs-normalize-tests--normalize NFD source)) + (equal nfd (ucs-normalize-tests--normalize NFD nfc)) + (equal nfd (ucs-normalize-tests--normalize NFD nfd)) + ;; c5 == toNFD(c4) == toNFD(c5) + (equal nfkd (ucs-normalize-tests--normalize NFD nfkc)) + (equal nfkd (ucs-normalize-tests--normalize NFD nfkd)) + + ;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) == toNFKC(c5) + (equal nfkc (ucs-normalize-tests--normalize NFKC source)) + (equal nfkc (ucs-normalize-tests--normalize NFKC nfc)) + (equal nfkc (ucs-normalize-tests--normalize NFKC nfd)) + (equal nfkc (ucs-normalize-tests--normalize NFKC nfkc)) + (equal nfkc (ucs-normalize-tests--normalize NFKC nfkd)) + + ;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) == toNFKD(c5) + (equal nfkd (ucs-normalize-tests--normalize NFKD source)) + (equal nfkd (ucs-normalize-tests--normalize NFKD nfc)) + (equal nfkd (ucs-normalize-tests--normalize NFKD nfd)) + (equal nfkd (ucs-normalize-tests--normalize NFKD nfkc)) + (equal nfkd (ucs-normalize-tests--normalize NFKD nfkd))))) + +(defun ucs-normalize-tests--invariants-rule2-hold-p (char) + "Check 2nd conformance rule. +For every code point X assigned in this version of Unicode that is not specifically +listed in Part 1, the following invariants must be true for all conformant +implementations: + + X == toNFC(X) == toNFD(X) == toNFKC(X) == toNFKD(X)" + (let ((X (string char))) + (and (equal X (ucs-normalize-tests--normalize NFC X)) + (equal X (ucs-normalize-tests--normalize NFD X)) + (equal X (ucs-normalize-tests--normalize NFKC X)) + (equal X (ucs-normalize-tests--normalize NFKD X))))) + +(cl-defun ucs-normalize-tests--invariants-failing-for-part (part &optional skip-lines &key progress-str) + "Returns a list of failed line numbers." + (with-temp-buffer + (insert-file-contents ucs-normalize-test-data-file) + (let ((beg-line (progn (search-forward (format "@Part%d" part)) + (forward-line) + (line-number-at-pos))) + (end-line (progn (or (search-forward (format "@Part%d" (1+ part)) nil t) + (goto-char (point-max))) + (line-number-at-pos)))) + (goto-char (point-min)) + (forward-line (1- beg-line)) + (cl-loop with reporter = (if progress-str (make-progress-reporter + progress-str beg-line end-line + 0 nil 0.5)) + for line from beg-line to (1- end-line) + unless (or (= (following-char) ?#) + (ucs-normalize-tests--invariants-hold-p + (ucs-normalize-tests--parse-column) + (ucs-normalize-tests--parse-column) + (ucs-normalize-tests--parse-column) + (ucs-normalize-tests--parse-column) + (ucs-normalize-tests--parse-column)) + (memq line skip-lines)) + collect line + do (forward-line) + if reporter do (progress-reporter-update reporter line))))) + +(defun ucs-normalize-tests--invariants-failing-for-lines (lines) + "Returns a list of failed line numbers." + (with-temp-buffer + (insert-file-contents ucs-normalize-test-data-file) + (goto-char (point-min)) + (cl-loop for prev-line = 1 then line + for line in lines + do (forward-line (- line prev-line)) + unless (ucs-normalize-tests--invariants-hold-p + (ucs-normalize-tests--parse-column) + (ucs-normalize-tests--parse-column) + (ucs-normalize-tests--parse-column) + (ucs-normalize-tests--parse-column) + (ucs-normalize-tests--parse-column)) + collect line))) + +(ert-deftest ucs-normalize-part0 () + (should-not (ucs-normalize-tests--invariants-failing-for-part 0))) + +(defconst ucs-normalize-tests--failing-lines-part1 + (list 15131 15132 15133 15134 15135 15136 15137 15138 + 15139 + 16149 16150 16151 16152 16153 16154 16155 16156 + 16157 16158 16159 16160 16161 16162 16163 16164 + 16165 16166 16167 16168 16169 16170 16171 16172 + 16173 16174 16175 16176 16177 16178 16179 16180 + 16181 16182 16183 16184 16185 16186 16187 16188 + 16189 16190 16191 16192 16193 16194 16195 16196 + 16197 16198 16199 16200 16201 16202 16203 16204 + 16205 16206 16207 16208 16209 16210 16211 16212 + 16213 16214 16215 16216 16217 16218 16219 16220 + 16221 16222 16223 16224 16225 16226 16227 16228 + 16229 16230 16231 16232 16233 16234 16235 16236 + 16237 16238 16239 16240 16241 16242 16243 16244 + 16245 16246 16247 16248 16249 16250 16251 16252 + 16253 16254 16255 16256 16257 16258 16259 16260 + 16261 16262 16263 16264 16265 16266 16267 16268 + 16269 16270 16271 16272 16273 16274 16275 16276 + 16277 16278 16279 16280 16281 16282 16283 16284 + 16285 16286 16287 16288 16289)) + +;; Keep a record of failures, for consulting afterwards (the ert +;; backtrace only shows a truncated version of these lists). +(defvar ucs-normalize-tests--part1-rule1-failed-lines nil + "A list of line numbers.") +(defvar ucs-normalize-tests--part1-rule2-failed-chars nil + "A list of code points.") + +(defun ucs-normalize-tests--part1-rule2 (chars-part1) + (let ((reporter (make-progress-reporter "UCS Normalize Test Part1, rule 2" + 0 (max-char))) + (failed-chars nil)) + (map-char-table + (lambda (char-range listed-in-part) + (unless (eq listed-in-part 1) + (if (characterp char-range) + (progn (unless (ucs-normalize-tests--invariants-rule2-hold-p char-range) + (push char-range failed-chars)) + (progress-reporter-update reporter char-range)) + (cl-loop for char from (car char-range) to (cdr char-range) + unless (ucs-normalize-tests--invariants-rule2-hold-p char) + do (push char failed-chars) + do (progress-reporter-update reporter char))))) + chars-part1) + (progress-reporter-done reporter) + failed-chars)) + +(ert-deftest ucs-normalize-part1 () + :tags '(:expensive-test) + ;; This takes a long time, so make sure we're compiled. + (dolist (fun '(ucs-normalize-tests--part1-rule2 + ucs-normalize-tests--invariants-failing-for-part + ucs-normalize-tests--invariants-hold-p + ucs-normalize-tests--invariants-rule2-hold-p)) + (or (byte-code-function-p (symbol-function fun)) + (byte-compile fun))) + (let ((ucs-normalize-tests--chars-part1 (make-char-table 'ucs-normalize-tests t))) + (should-not + (setq ucs-normalize-tests--part1-rule1-failed-lines + (ucs-normalize-tests--invariants-failing-for-part + 1 ucs-normalize-tests--failing-lines-part1 + :progress-str "UCS Normalize Test Part1, rule 1"))) + (should-not (setq ucs-normalize-tests--part1-rule2-failed-chars + (ucs-normalize-tests--part1-rule2 + ucs-normalize-tests--chars-part1))))) + +(ert-deftest ucs-normalize-part1-failing () + :expected-result :failed + (skip-unless ucs-normalize-tests--failing-lines-part1) + (should-not + (ucs-normalize-tests--invariants-failing-for-lines + ucs-normalize-tests--failing-lines-part1))) + +(defconst ucs-normalize-tests--failing-lines-part2 + (list 18328 18330 18332 18334 18336 18338 18340 18342 + 18344 18346 18348 18350 18352 18354 18356 18358 + 18360 18362 18364 18366 18368 18370 18372 18374 + 18376 18378 18380 18382 18384 18386 18388 18390 + 18392 18394 18396 18398 18400 18402 18404 18406 + 18408 18410 18412 18414 18416 18418 18420 18422 + 18424 18426 18494 18496 18498 18500 18502 18504 + 18506 18508 18510 18512 18514 18516 18518 18520 + 18522 18524 18526 18528 18530 18532 18534 18536 + 18538 18540 18542 18544 18546 18548 18550 18552 + 18554 18556 18558 18560 18562 18564 18566 18568 + 18570 18572 18574 18576 18578 18580 18582 18584 + 18586 18588 18590 18592 18594 18596)) + +(ert-deftest ucs-normalize-part2 () + :tags '(:expensive-test) + (should-not + (ucs-normalize-tests--invariants-failing-for-part + 2 ucs-normalize-tests--failing-lines-part2 + :progress-str "UCS Normalize Test Part2"))) + +(ert-deftest ucs-normalize-part2-failing () + :expected-result :failed + (skip-unless ucs-normalize-tests--failing-lines-part2) + (should-not + (ucs-normalize-tests--invariants-failing-for-lines + ucs-normalize-tests--failing-lines-part2))) + +(ert-deftest ucs-normalize-part3 () + (should-not + (ucs-normalize-tests--invariants-failing-for-part 3))) + +;;; ucs-normalize-tests.el ends here diff --git a/test/automated/isearch-tests.el b/test/lisp/isearch-tests.el index 52f312d0b97..52f312d0b97 100644 --- a/test/automated/isearch-tests.el +++ b/test/lisp/isearch-tests.el diff --git a/test/lisp/jit-lock-tests.el b/test/lisp/jit-lock-tests.el new file mode 100644 index 00000000000..dcb6936e320 --- /dev/null +++ b/test/lisp/jit-lock-tests.el @@ -0,0 +1,60 @@ +;;; jit-lock-tests.el --- tests for jit-lock + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Dmitry Gutov <dgutov@yandex.ru> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'jit-lock) +(require 'ert-x) + +(defun jit-lock-tests--setup-buffer () + (setq font-lock-defaults '(nil t)) + (let (noninteractive) + (font-lock-mode))) + +(ert-deftest jit-lock-fontify-now-fontifies-a-new-buffer () + (ert-with-test-buffer (:name "xxx") + (jit-lock-tests--setup-buffer) + (insert "xyz") + (jit-lock-fontify-now (point-min) (point-max)) + (should-not (text-property-not-all (point-min) (point-max) 'fontified t)))) + +(ert-deftest jit-lock-fontify-now-mends-the-gaps () + (ert-with-test-buffer (:name "xxx") + (jit-lock-tests--setup-buffer) + (insert "aaabbbcccddd") + (with-silent-modifications + (put-text-property 1 4 'fontified t) + (put-text-property 7 10 'fontified t)) + (jit-lock-fontify-now (point-min) (point-max)) + (should-not (text-property-not-all (point-min) (point-max) 'fontified t)))) + +(ert-deftest jit-lock-fontify-now-does-not-refontify-unnecessarily () + (ert-with-test-buffer (:name "xxx") + (setq font-lock-defaults + (list '(((lambda () (error "Don't call me")))) t)) + (let (noninteractive) + (font-lock-mode)) + (insert "aaa") + (with-silent-modifications + (put-text-property (point-min) (point-max) 'fontified t)) + (jit-lock-fontify-now (point-min) (point-max)))) diff --git a/test/automated/json-tests.el b/test/lisp/json-tests.el index 78cebb45eed..78cebb45eed 100644 --- a/test/automated/json-tests.el +++ b/test/lisp/json-tests.el diff --git a/test/automated/replace-tests.el b/test/lisp/mail/rmail-tests.el index bfaab6c8944..2f18372146a 100644 --- a/test/automated/replace-tests.el +++ b/test/lisp/mail/rmail-tests.el @@ -1,4 +1,4 @@ -;;; replace-tests.el --- tests for replace.el. +;;; rmail-tests.el --- Test suite. -*- lexical-binding: t -*- ;; Copyright (C) 2015-2016 Free Software Foundation, Inc. @@ -18,18 +18,18 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Code: - (require 'ert) +(require 'rmail) + + +(ert-deftest rmail-autoload () + "Tests to see whether reftex-auc has been autoloaded" + (should + (fboundp 'rmail-edit-current-message)) + (should + (autoloadp + (symbol-function + 'rmail-edit-current-message)))) -(ert-deftest query-replace--split-string-tests () - (let ((sep (propertize "\0" 'separator t))) - (dolist (before '("" "b")) - (dolist (after '("" "a")) - (should (equal - (query-replace--split-string (concat before sep after)) - (cons before after))) - (should (equal - (query-replace--split-string (concat before "\0" after)) - (concat before "\0" after))))))) - -;;; replace-tests.el ends here +(provide 'rmail-tests) +;; rmail-tests.el ends here diff --git a/test/automated/man-tests.el b/test/lisp/man-tests.el index b1cc4437256..b1cc4437256 100644 --- a/test/automated/man-tests.el +++ b/test/lisp/man-tests.el diff --git a/test/automated/completion-tests.el b/test/lisp/minibuffer-tests.el index 0f2abf45673..0f2abf45673 100644 --- a/test/automated/completion-tests.el +++ b/test/lisp/minibuffer-tests.el diff --git a/test/lisp/mouse-tests.el b/test/lisp/mouse-tests.el new file mode 100644 index 00000000000..204f5d3b8d8 --- /dev/null +++ b/test/lisp/mouse-tests.el @@ -0,0 +1,50 @@ +;;; mouse-tests.el --- unit tests for mouse.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Philipp Stephani <phst@google.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for lisp/mouse.el. + +;;; Code: + +(ert-deftest bug23288-use-return-value () + "If ‘mouse-on-link-p’ returns a string, its first character is +used." + (cl-letf ((last-input-event '(down-mouse-1 nil 1)) + (unread-command-events '((mouse-1 nil 1))) + (mouse-1-click-follows-link t) + (mouse-1-click-in-non-selected-windows t) + ((symbol-function 'mouse-on-link-p) (lambda (_pos) "abc"))) + (should-not (mouse--down-1-maybe-follows-link)) + (should (equal unread-command-events '(?a))))) + +(ert-deftest bug23288-translate-to-mouse-2 () + "If ‘mouse-on-link-p’ doesn’t return a string or vector, +translate ‘mouse-1’ events into ‘mouse-2’ events." + (cl-letf ((last-input-event '(down-mouse-1 nil 1)) + (unread-command-events '((mouse-1 nil 1))) + (mouse-1-click-follows-link t) + (mouse-1-click-in-non-selected-windows t) + ((symbol-function 'mouse-on-link-p) (lambda (_pos) t))) + (should-not (mouse--down-1-maybe-follows-link)) + (should (equal unread-command-events '((mouse-2 nil 1)))))) + +;;; mouse-tests.el ends here diff --git a/test/automated/dbus-tests.el b/test/lisp/net/dbus-tests.el index 12be1637109..12be1637109 100644 --- a/test/automated/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el new file mode 100644 index 00000000000..afffeeb1932 --- /dev/null +++ b/test/lisp/net/network-stream-tests.el @@ -0,0 +1,294 @@ +;;; network-stream-tests.el --- tests for network processes -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Lars Ingebrigtsen <larsi@gnus.org> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + + +;;; Code: + +(require 'gnutls) + +(ert-deftest make-local-unix-server () + (skip-unless (featurep 'make-network-process '(:family local))) + (let* ((file (make-temp-name "/tmp/server-test")) + (server + (make-network-process + :name "server" + :server t + :buffer (get-buffer-create "*server*") + :noquery t + :family 'local + :service file))) + (should (equal (process-contact server :local) file)) + (delete-file (process-contact server :local)))) + +(ert-deftest make-ipv4-tcp-server-with-unspecified-port () + (let ((server + (make-network-process + :name "server" + :server t + :noquery t + :family 'ipv4 + :service t + :host 'local))) + (should (and (arrayp (process-contact server :local)) + (numberp (aref (process-contact server :local) 4)) + (> (aref (process-contact server :local) 4) 0))) + (delete-process server))) + +(ert-deftest make-ipv4-tcp-server-with-specified-port () + (let ((server + (make-network-process + :name "server" + :server t + :noquery t + :family 'ipv4 + :service 57869 + :host 'local))) + (should (and (arrayp (process-contact server :local)) + (= (aref (process-contact server :local) 4) 57869))) + (delete-process server))) + +(defun make-server (host) + (make-network-process + :name "server" + :server t + :noquery t + :family 'ipv4 + :coding 'raw-text-unix + :buffer (get-buffer-create "*server*") + :service t + :sentinel 'server-sentinel + :filter 'server-process-filter + :host host)) + +(defun server-sentinel (_proc _msg) + ) + +(defun server-process-filter (proc string) + (message "Received %s" string) + (let ((prev (process-get proc 'previous-string))) + (when prev + (setq string (concat prev string)) + (process-put proc 'previous-string nil))) + (if (and (not (string-match "\n" string)) + (> (length string) 0)) + (process-put proc 'previous-string string)) + (let ((command (split-string string))) + (cond + ((equal (car command) "echo") + (process-send-string proc (concat (cadr command) "\n"))) + (t + )))) + +(ert-deftest echo-server-with-dns () + (let* ((server (make-server (system-name))) + (port (aref (process-contact server :local) 4)) + (proc (make-network-process :name "foo" + :buffer (generate-new-buffer "*foo*") + :host (system-name) + :service port))) + (with-current-buffer (process-buffer proc) + (process-send-string proc "echo foo") + (sleep-for 0.1) + (should (equal (buffer-string) "foo\n"))) + (delete-process server))) + +(ert-deftest echo-server-with-localhost () + (let* ((server (make-server 'local)) + (port (aref (process-contact server :local) 4)) + (proc (make-network-process :name "foo" + :buffer (generate-new-buffer "*foo*") + :host "localhost" + :service port))) + (with-current-buffer (process-buffer proc) + (process-send-string proc "echo foo") + (sleep-for 0.1) + (should (equal (buffer-string) "foo\n"))) + (delete-process server))) + +(ert-deftest echo-server-with-ip () + (let* ((server (make-server 'local)) + (port (aref (process-contact server :local) 4)) + (proc (make-network-process :name "foo" + :buffer (generate-new-buffer "*foo*") + :host "127.0.0.1" + :service port))) + (with-current-buffer (process-buffer proc) + (process-send-string proc "echo foo") + (sleep-for 0.1) + (should (equal (buffer-string) "foo\n"))) + (delete-process server))) + +(ert-deftest echo-server-nowait () + (let* ((server (make-server 'local)) + (port (aref (process-contact server :local) 4)) + (proc (make-network-process :name "foo" + :buffer (generate-new-buffer "*foo*") + :host "localhost" + :nowait t + :family 'ipv4 + :service port)) + (times 0)) + (should (eq (process-status proc) 'connect)) + (while (and (eq (process-status proc) 'connect) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should-not (eq (process-status proc) 'connect)) + (with-current-buffer (process-buffer proc) + (process-send-string proc "echo foo") + (sleep-for 0.1) + (should (equal (buffer-string) "foo\n"))) + (delete-process server))) + +(defconst network-stream-tests--datadir + (expand-file-name "test/data/net" source-directory)) + +(defun make-tls-server (port) + (start-process "gnutls" (generate-new-buffer "*tls*") + "gnutls-serv" "--http" + "--x509keyfile" + (concat network-stream-tests--datadir "/key.pem") + "--x509certfile" + (concat network-stream-tests--datadir "/cert.pem") + "--port" (format "%s" port))) + +(ert-deftest connect-to-tls-ipv4-wait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44332)) + (times 0) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (make-network-process + :name "bar" + :buffer (generate-new-buffer "*foo*") + :host "localhost" + :service 44332)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (gnutls-negotiate :process proc + :type 'gnutls-x509pki + :hostname "localhost")) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + ;; This sleep-for is needed for the native MS-Windows build. If + ;; it is removed, the next test mysteriously fails because the + ;; initial part of the echo is not received. + (sleep-for 0.1) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +(ert-deftest connect-to-tls-ipv4-nowait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let ((server (make-tls-server 44331)) + (times 0) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (make-network-process + :name "bar" + :buffer (generate-new-buffer "*foo*") + :nowait t + :tls-parameters + (cons 'gnutls-x509pki + (gnutls-boot-parameters + :hostname "localhost")) + :host "localhost" + :service 44331)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (setq times 0) + (while (and (eq (process-status proc) 'connect) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should-not (eq (process-status proc) 'connect))) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +(ert-deftest connect-to-tls-ipv6-nowait () + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (skip-unless (not (eq system-type 'windows-nt))) + (skip-unless (featurep 'make-network-process '(:family ipv6))) + (let ((server (make-tls-server 44333)) + (times 0) + proc status) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "gnutls-serv: %s" (buffer-string))) + + ;; It takes a while for gnutls-serv to start. + (while (and (null (ignore-errors + (setq proc (make-network-process + :name "bar" + :buffer (generate-new-buffer "*foo*") + :family 'ipv6 + :nowait t + :tls-parameters + (cons 'gnutls-x509pki + (gnutls-boot-parameters + :hostname "localhost")) + :host "::1" + :service 44333)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (while (eq (process-status proc) 'connect) + (sit-for 0.1))) + (if (process-live-p server) (delete-process server))) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + (let ((issuer (plist-get (plist-get status :certificate) :issuer))) + (should (stringp issuer)) + (setq issuer (split-string issuer ",")) + (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))) + +;;; network-stream-tests.el ends here diff --git a/test/automated/newsticker-tests.el b/test/lisp/net/newsticker-tests.el index d8531083e60..d8531083e60 100644 --- a/test/automated/newsticker-tests.el +++ b/test/lisp/net/newsticker-tests.el diff --git a/test/automated/sasl-scram-rfc-tests.el b/test/lisp/net/sasl-scram-rfc-tests.el index 130de240481..130de240481 100644 --- a/test/automated/sasl-scram-rfc-tests.el +++ b/test/lisp/net/sasl-scram-rfc-tests.el diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el new file mode 100644 index 00000000000..501916fc8bf --- /dev/null +++ b/test/lisp/net/shr-tests.el @@ -0,0 +1,58 @@ +;;; network-stream-tests.el --- tests for network processes -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Lars Ingebrigtsen <larsi@gnus.org> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'shr) + +(defconst shr-tests--datadir + (expand-file-name "test/data/shr" source-directory)) + +(defun shr-test (name) + (with-temp-buffer + (insert-file-contents (format (concat shr-tests--datadir "/%s.html") name)) + (let ((dom (libxml-parse-html-region (point-min) (point-max))) + (shr-width 80) + (shr-use-fonts nil)) + (erase-buffer) + (shr-insert-document dom) + (cons (buffer-substring-no-properties (point-min) (point-max)) + (with-temp-buffer + (insert-file-contents + (format (concat shr-tests--datadir "/%s.txt") name)) + (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t) + (replace-match (string (string-to-number (match-string 1) 16)) + t t)) + (buffer-string)))))) + +(ert-deftest rendering () + (skip-unless (fboundp 'libxml-parse-html-region)) + (dolist (file (directory-files shr-tests--datadir nil "\\.html\\'")) + (let* ((name (replace-regexp-in-string "\\.html\\'" "" file)) + (result (shr-test name))) + (unless (equal (car result) (cdr result)) + (should (not (list name (car result) (cdr result)))))))) + +(require 'shr) + +;;; shr-stream-tests.el ends here diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el new file mode 100644 index 00000000000..22b60db04f5 --- /dev/null +++ b/test/lisp/net/tramp-tests.el @@ -0,0 +1,2696 @@ +;;; tramp-tests.el --- Tests of remote file access + +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. + +;; Author: Michael Albinus <michael.albinus@gmx.de> + +;; This program 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, 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 `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; The tests require a recent ert.el from Emacs 24.4. + +;; Some of the tests require access to a remote host files. Since +;; this could be problematic, a mock-up connection method "mock" is +;; used. Emulating a remote connection, it simply calls "sh -i". +;; Tramp's file name handlers still run, so this test is sufficient +;; except for connection establishing. + +;; If you want to test a real Tramp connection, set +;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to +;; overwrite the default value. If you want to skip tests accessing a +;; remote host, set this environment variable to "/dev/null" or +;; whatever is appropriate on your system. + +;; A whole test run can be performed calling the command `tramp-test-all'. + +;;; Code: + +(require 'ert) +(require 'tramp) +(require 'vc) +(require 'vc-bzr) +(require 'vc-git) +(require 'vc-hg) + +(autoload 'dired-uncache "dired") +(declare-function tramp-find-executable "tramp-sh") +(declare-function tramp-get-remote-path "tramp-sh") +(declare-function tramp-get-remote-stat "tramp-sh") +(declare-function tramp-get-remote-perl "tramp-sh") +(defvar tramp-copy-size-limit) +(defvar tramp-persistency-file-name) +(defvar tramp-remote-process-environment) + +;; There is no default value on w32 systems, which could work out of the box. +(defconst tramp-test-temporary-file-directory + (cond + ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) + ((eq system-type 'windows-nt) null-device) + (t (add-to-list + 'tramp-methods + '("mock" + (tramp-login-program "sh") + (tramp-login-args (("-i"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-connection-timeout 10))) + (format "/mock::%s" temporary-file-directory))) + "Temporary directory for Tramp tests.") + +(setq password-cache-expiry nil + tramp-verbose 0 + tramp-copy-size-limit nil + tramp-message-show-message nil + tramp-persistency-file-name nil) + +;; This shall happen on hydra only. +(when (getenv "NIX_STORE") + (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) + +(defvar tramp--test-expensive-test + (null + (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))")) + "Whether expensive tests are run.") + +(defvar tramp--test-enabled-checked nil + "Cached result of `tramp--test-enabled'. +If the function did run, the value is a cons cell, the `cdr' +being the result.") + +(defun tramp--test-enabled () + "Whether remote file access is enabled." + (unless (consp tramp--test-enabled-checked) + (setq + tramp--test-enabled-checked + (cons + t (ignore-errors + (and + (file-remote-p tramp-test-temporary-file-directory) + (file-directory-p tramp-test-temporary-file-directory) + (file-writable-p tramp-test-temporary-file-directory)))))) + + (when (cdr tramp--test-enabled-checked) + ;; Cleanup connection. + (ignore-errors + (tramp-cleanup-connection + (tramp-dissect-file-name tramp-test-temporary-file-directory) + nil 'keep-password))) + + ;; Return result. + (cdr tramp--test-enabled-checked)) + +(defun tramp--test-make-temp-name (&optional local quoted) + "Create a temporary file name for test. +If LOCAL is non-nil, a local file is created. +If QUOTED is non-nil, the local part of the file is quoted." + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (expand-file-name + (make-temp-name "tramp-test") + (if local temporary-file-directory tramp-test-temporary-file-directory)))) + +(defmacro tramp--instrument-test-case (verbose &rest body) + "Run BODY with `tramp-verbose' equal VERBOSE. +Print the the content of the Tramp debug buffer, if BODY does not +eval properly in `should' or `should-not'. `should-error' is not +handled properly. BODY shall not contain a timeout." + (declare (indent 1) (debug (natnump body))) + `(let ((tramp-verbose ,verbose) + (tramp-debug-on-error t) + (debug-ignored-errors + (cons "^make-symbolic-link not supported$" debug-ignored-errors))) + (unwind-protect + (progn ,@body) + (when (> tramp-verbose 3) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (with-current-buffer (tramp-get-connection-buffer v) + (message "%s" (buffer-string))) + (with-current-buffer (tramp-get-debug-buffer v) + (message "%s" (buffer-string)))))))) + +(ert-deftest tramp-test00-availability () + "Test availability of Tramp functions." + :expected-result (if (tramp--test-enabled) :passed :failed) + (message "Remote directory: `%s'" tramp-test-temporary-file-directory) + (should (ignore-errors + (and + (file-remote-p tramp-test-temporary-file-directory) + (file-directory-p tramp-test-temporary-file-directory) + (file-writable-p tramp-test-temporary-file-directory))))) + +(ert-deftest tramp-test01-file-name-syntax () + "Check remote file name syntax." + ;; Simple cases. + (should (tramp-tramp-file-p "/method::")) + (should (tramp-tramp-file-p "/host:")) + (should (tramp-tramp-file-p "/user@:")) + (should (tramp-tramp-file-p "/user@host:")) + (should (tramp-tramp-file-p "/method:host:")) + (should (tramp-tramp-file-p "/method:user@:")) + (should (tramp-tramp-file-p "/method:user@host:")) + (should (tramp-tramp-file-p "/method:user@email@host:")) + + ;; Using a port. + (should (tramp-tramp-file-p "/host#1234:")) + (should (tramp-tramp-file-p "/user@host#1234:")) + (should (tramp-tramp-file-p "/method:host#1234:")) + (should (tramp-tramp-file-p "/method:user@host#1234:")) + + ;; Using an IPv4 address. + (should (tramp-tramp-file-p "/1.2.3.4:")) + (should (tramp-tramp-file-p "/user@1.2.3.4:")) + (should (tramp-tramp-file-p "/method:1.2.3.4:")) + (should (tramp-tramp-file-p "/method:user@1.2.3.4:")) + + ;; Using an IPv6 address. + (should (tramp-tramp-file-p "/[]:")) + (should (tramp-tramp-file-p "/[::1]:")) + (should (tramp-tramp-file-p "/user@[::1]:")) + (should (tramp-tramp-file-p "/method:[::1]:")) + (should (tramp-tramp-file-p "/method:user@[::1]:")) + + ;; Local file name part. + (should (tramp-tramp-file-p "/host:/:")) + (should (tramp-tramp-file-p "/method:::")) + (should (tramp-tramp-file-p "/method::/:")) + (should (tramp-tramp-file-p "/method::/path/to/file")) + (should (tramp-tramp-file-p "/method::/:/path/to/file")) + (should (tramp-tramp-file-p "/method::file")) + (should (tramp-tramp-file-p "/method::/:file")) + + ;; Multihop. + (should (tramp-tramp-file-p "/method1:|method2::")) + (should (tramp-tramp-file-p "/method1:host1|host2:")) + (should (tramp-tramp-file-p "/method1:host1|method2:host2:")) + (should (tramp-tramp-file-p "/method1:user1@host1|method2:user2@host2:")) + (should (tramp-tramp-file-p + "/method1:user1@host1|method2:user2@host2|method3:user3@host3:")) + (should (tramp-tramp-file-p "/host1|host2:")) + (should (tramp-tramp-file-p "/user1@host1|user2@host2:")) + + ;; No strings. + (should-not (tramp-tramp-file-p nil)) + (should-not (tramp-tramp-file-p 'symbol)) + ;; Quote with "/:" suppresses file name handlers. + (should-not (tramp-tramp-file-p "/::")) + (should-not (tramp-tramp-file-p "/:@:")) + (should-not (tramp-tramp-file-p "/:[]:")) + ;; Methods or host names shall be at least two characters on MS Windows. + (let ((system-type 'windows-nt)) + (should-not (tramp-tramp-file-p "/c:/path/to/file")) + (should-not (tramp-tramp-file-p "/c::/path/to/file"))) + (let ((system-type 'gnu/linux)) + (should (tramp-tramp-file-p "/h:/path/to/file")) + (should (tramp-tramp-file-p "/m::/path/to/file")))) + +(ert-deftest tramp-test02-file-name-dissect () + "Check remote file name components." + (let ((tramp-default-method "default-method") + (tramp-default-user "default-user") + (tramp-default-host "default-host")) + ;; Expand `tramp-default-user' and `tramp-default-host'. + (should (string-equal + (file-remote-p "/method::") + (format "/%s:%s@%s:" "method" "default-user" "default-host"))) + (should (string-equal (file-remote-p "/method::" 'method) "method")) + (should (string-equal (file-remote-p "/method::" 'user) "default-user")) + (should (string-equal (file-remote-p "/method::" 'host) "default-host")) + (should (string-equal (file-remote-p "/method::" 'localname) "")) + (should (string-equal (file-remote-p "/method::" 'hop) nil)) + + ;; Expand `tramp-default-method' and `tramp-default-user'. + (should (string-equal + (file-remote-p "/host:") + (format "/%s:%s@%s:" "default-method" "default-user" "host"))) + (should (string-equal (file-remote-p "/host:" 'method) "default-method")) + (should (string-equal (file-remote-p "/host:" 'user) "default-user")) + (should (string-equal (file-remote-p "/host:" 'host) "host")) + (should (string-equal (file-remote-p "/host:" 'localname) "")) + (should (string-equal (file-remote-p "/host:" 'hop) nil)) + + ;; Expand `tramp-default-method' and `tramp-default-host'. + (should (string-equal + (file-remote-p "/user@:") + (format "/%s:%s@%s:" "default-method""user" "default-host"))) + (should (string-equal (file-remote-p "/user@:" 'method) "default-method")) + (should (string-equal (file-remote-p "/user@:" 'user) "user")) + (should (string-equal (file-remote-p "/user@:" 'host) "default-host")) + (should (string-equal (file-remote-p "/user@:" 'localname) "")) + (should (string-equal (file-remote-p "/user@:" 'hop) nil)) + + ;; Expand `tramp-default-method'. + (should (string-equal + (file-remote-p "/user@host:") + (format "/%s:%s@%s:" "default-method" "user" "host"))) + (should (string-equal + (file-remote-p "/user@host:" 'method) "default-method")) + (should (string-equal (file-remote-p "/user@host:" 'user) "user")) + (should (string-equal (file-remote-p "/user@host:" 'host) "host")) + (should (string-equal (file-remote-p "/user@host:" 'localname) "")) + (should (string-equal (file-remote-p "/user@host:" 'hop) nil)) + + ;; Expand `tramp-default-user'. + (should (string-equal + (file-remote-p "/method:host:") + (format "/%s:%s@%s:" "method" "default-user" "host"))) + (should (string-equal (file-remote-p "/method:host:" 'method) "method")) + (should (string-equal (file-remote-p "/method:host:" 'user) "default-user")) + (should (string-equal (file-remote-p "/method:host:" 'host) "host")) + (should (string-equal (file-remote-p "/method:host:" 'localname) "")) + (should (string-equal (file-remote-p "/method:host:" 'hop) nil)) + + ;; Expand `tramp-default-host'. + (should (string-equal + (file-remote-p "/method:user@:") + (format "/%s:%s@%s:" "method" "user" "default-host"))) + (should (string-equal (file-remote-p "/method:user@:" 'method) "method")) + (should (string-equal (file-remote-p "/method:user@:" 'user) "user")) + (should (string-equal (file-remote-p "/method:user@:" 'host) + "default-host")) + (should (string-equal (file-remote-p "/method:user@:" 'localname) "")) + (should (string-equal (file-remote-p "/method:user@:" 'hop) nil)) + + ;; No expansion. + (should (string-equal + (file-remote-p "/method:user@host:") + (format "/%s:%s@%s:" "method" "user" "host"))) + (should (string-equal + (file-remote-p "/method:user@host:" 'method) "method")) + (should (string-equal (file-remote-p "/method:user@host:" 'user) "user")) + (should (string-equal (file-remote-p "/method:user@host:" 'host) "host")) + (should (string-equal (file-remote-p "/method:user@host:" 'localname) "")) + (should (string-equal (file-remote-p "/method:user@host:" 'hop) nil)) + + ;; No expansion. + (should (string-equal + (file-remote-p "/method:user@email@host:") + (format "/%s:%s@%s:" "method" "user@email" "host"))) + (should (string-equal + (file-remote-p "/method:user@email@host:" 'method) "method")) + (should (string-equal + (file-remote-p "/method:user@email@host:" 'user) "user@email")) + (should (string-equal + (file-remote-p "/method:user@email@host:" 'host) "host")) + (should (string-equal + (file-remote-p "/method:user@email@host:" 'localname) "")) + (should (string-equal + (file-remote-p "/method:user@email@host:" 'hop) nil)) + + ;; Expand `tramp-default-method' and `tramp-default-user'. + (should (string-equal + (file-remote-p "/host#1234:") + (format "/%s:%s@%s:" "default-method" "default-user" "host#1234"))) + (should (string-equal + (file-remote-p "/host#1234:" 'method) "default-method")) + (should (string-equal (file-remote-p "/host#1234:" 'user) "default-user")) + (should (string-equal (file-remote-p "/host#1234:" 'host) "host#1234")) + (should (string-equal (file-remote-p "/host#1234:" 'localname) "")) + (should (string-equal (file-remote-p "/host#1234:" 'hop) nil)) + + ;; Expand `tramp-default-method'. + (should (string-equal + (file-remote-p "/user@host#1234:") + (format "/%s:%s@%s:" "default-method" "user" "host#1234"))) + (should (string-equal + (file-remote-p "/user@host#1234:" 'method) "default-method")) + (should (string-equal (file-remote-p "/user@host#1234:" 'user) "user")) + (should (string-equal (file-remote-p "/user@host#1234:" 'host) "host#1234")) + (should (string-equal (file-remote-p "/user@host#1234:" 'localname) "")) + (should (string-equal (file-remote-p "/user@host#1234:" 'hop) nil)) + + ;; Expand `tramp-default-user'. + (should (string-equal + (file-remote-p "/method:host#1234:") + (format "/%s:%s@%s:" "method" "default-user" "host#1234"))) + (should (string-equal + (file-remote-p "/method:host#1234:" 'method) "method")) + (should (string-equal + (file-remote-p "/method:host#1234:" 'user) "default-user")) + (should (string-equal + (file-remote-p "/method:host#1234:" 'host) "host#1234")) + (should (string-equal (file-remote-p "/method:host#1234:" 'localname) "")) + (should (string-equal (file-remote-p "/method:host#1234:" 'hop) nil)) + + ;; No expansion. + (should (string-equal + (file-remote-p "/method:user@host#1234:") + (format "/%s:%s@%s:" "method" "user" "host#1234"))) + (should (string-equal + (file-remote-p "/method:user@host#1234:" 'method) "method")) + (should (string-equal + (file-remote-p "/method:user@host#1234:" 'user) "user")) + (should (string-equal + (file-remote-p "/method:user@host#1234:" 'host) "host#1234")) + (should (string-equal + (file-remote-p "/method:user@host#1234:" 'localname) "")) + (should (string-equal + (file-remote-p "/method:user@host#1234:" 'hop) nil)) + + ;; Expand `tramp-default-method' and `tramp-default-user'. + (should (string-equal + (file-remote-p "/1.2.3.4:") + (format "/%s:%s@%s:" "default-method" "default-user" "1.2.3.4"))) + (should (string-equal (file-remote-p "/1.2.3.4:" 'method) "default-method")) + (should (string-equal (file-remote-p "/1.2.3.4:" 'user) "default-user")) + (should (string-equal (file-remote-p "/1.2.3.4:" 'host) "1.2.3.4")) + (should (string-equal (file-remote-p "/1.2.3.4:" 'localname) "")) + (should (string-equal (file-remote-p "/1.2.3.4:" 'hop) nil)) + + ;; Expand `tramp-default-method'. + (should (string-equal + (file-remote-p "/user@1.2.3.4:") + (format "/%s:%s@%s:" "default-method" "user" "1.2.3.4"))) + (should (string-equal + (file-remote-p "/user@1.2.3.4:" 'method) "default-method")) + (should (string-equal (file-remote-p "/user@1.2.3.4:" 'user) "user")) + (should (string-equal (file-remote-p "/user@1.2.3.4:" 'host) "1.2.3.4")) + (should (string-equal (file-remote-p "/user@1.2.3.4:" 'localname) "")) + (should (string-equal (file-remote-p "/user@1.2.3.4:" 'hop) nil)) + + ;; Expand `tramp-default-user'. + (should (string-equal + (file-remote-p "/method:1.2.3.4:") + (format "/%s:%s@%s:" "method" "default-user" "1.2.3.4"))) + (should (string-equal (file-remote-p "/method:1.2.3.4:" 'method) "method")) + (should (string-equal + (file-remote-p "/method:1.2.3.4:" 'user) "default-user")) + (should (string-equal (file-remote-p "/method:1.2.3.4:" 'host) "1.2.3.4")) + (should (string-equal (file-remote-p "/method:1.2.3.4:" 'localname) "")) + (should (string-equal (file-remote-p "/method:1.2.3.4:" 'hop) nil)) + + ;; No expansion. + (should (string-equal + (file-remote-p "/method:user@1.2.3.4:") + (format "/%s:%s@%s:" "method" "user" "1.2.3.4"))) + (should (string-equal + (file-remote-p "/method:user@1.2.3.4:" 'method) "method")) + (should (string-equal (file-remote-p "/method:user@1.2.3.4:" 'user) "user")) + (should (string-equal + (file-remote-p "/method:user@1.2.3.4:" 'host) "1.2.3.4")) + (should (string-equal + (file-remote-p "/method:user@1.2.3.4:" 'localname) "")) + (should (string-equal + (file-remote-p "/method:user@1.2.3.4:" 'hop) nil)) + + ;; Expand `tramp-default-method', `tramp-default-user' and + ;; `tramp-default-host'. + (should (string-equal + (file-remote-p "/[]:") + (format + "/%s:%s@%s:" "default-method" "default-user" "default-host"))) + (should (string-equal (file-remote-p "/[]:" 'method) "default-method")) + (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) + (should (string-equal (file-remote-p "/[]:" 'host) "default-host")) + (should (string-equal (file-remote-p "/[]:" 'localname) "")) + (should (string-equal (file-remote-p "/[]:" 'hop) nil)) + + ;; Expand `tramp-default-method' and `tramp-default-user'. + (let ((tramp-default-host "::1")) + (should (string-equal + (file-remote-p "/[]:") + (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) + (should (string-equal (file-remote-p "/[]:" 'method) "default-method")) + (should (string-equal (file-remote-p "/[]:" 'user) "default-user")) + (should (string-equal (file-remote-p "/[]:" 'host) "::1")) + (should (string-equal (file-remote-p "/[]:" 'localname) "")) + (should (string-equal (file-remote-p "/[]:" 'hop) nil))) + + ;; Expand `tramp-default-method' and `tramp-default-user'. + (should (string-equal + (file-remote-p "/[::1]:") + (format "/%s:%s@%s:" "default-method" "default-user" "[::1]"))) + (should (string-equal (file-remote-p "/[::1]:" 'method) "default-method")) + (should (string-equal (file-remote-p "/[::1]:" 'user) "default-user")) + (should (string-equal (file-remote-p "/[::1]:" 'host) "::1")) + (should (string-equal (file-remote-p "/[::1]:" 'localname) "")) + (should (string-equal (file-remote-p "/[::1]:" 'hop) nil)) + + ;; Expand `tramp-default-method'. + (should (string-equal + (file-remote-p "/user@[::1]:") + (format "/%s:%s@%s:" "default-method" "user" "[::1]"))) + (should (string-equal + (file-remote-p "/user@[::1]:" 'method) "default-method")) + (should (string-equal (file-remote-p "/user@[::1]:" 'user) "user")) + (should (string-equal (file-remote-p "/user@[::1]:" 'host) "::1")) + (should (string-equal (file-remote-p "/user@[::1]:" 'localname) "")) + (should (string-equal (file-remote-p "/user@[::1]:" 'hop) nil)) + + ;; Expand `tramp-default-user'. + (should (string-equal + (file-remote-p "/method:[::1]:") + (format "/%s:%s@%s:" "method" "default-user" "[::1]"))) + (should (string-equal (file-remote-p "/method:[::1]:" 'method) "method")) + (should (string-equal + (file-remote-p "/method:[::1]:" 'user) "default-user")) + (should (string-equal (file-remote-p "/method:[::1]:" 'host) "::1")) + (should (string-equal (file-remote-p "/method:[::1]:" 'localname) "")) + (should (string-equal (file-remote-p "/method:[::1]:" 'hop) nil)) + + ;; No expansion. + (should (string-equal + (file-remote-p "/method:user@[::1]:") + (format "/%s:%s@%s:" "method" "user" "[::1]"))) + (should (string-equal + (file-remote-p "/method:user@[::1]:" 'method) "method")) + (should (string-equal (file-remote-p "/method:user@[::1]:" 'user) "user")) + (should (string-equal (file-remote-p "/method:user@[::1]:" 'host) "::1")) + (should (string-equal + (file-remote-p "/method:user@[::1]:" 'localname) "")) + (should (string-equal (file-remote-p "/method:user@[::1]:" 'hop) nil)) + + ;; Local file name part. + (should (string-equal (file-remote-p "/host:/:" 'localname) "/:")) + (should (string-equal (file-remote-p "/method:::" 'localname) ":")) + (should (string-equal (file-remote-p "/method:: " 'localname) " ")) + (should (string-equal (file-remote-p "/method::file" 'localname) "file")) + (should (string-equal + (file-remote-p "/method::/path/to/file" 'localname) + "/path/to/file")) + + ;; Multihop. + (should + (string-equal + (file-remote-p "/method1:user1@host1|method2:user2@host2:/path/to/file") + (format "/%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" "method2" "user2" "host2"))) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) + "method2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) + "user2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) + "host2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop) + (format "%s:%s@%s|" + "method1" "user1" "host1"))) + + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file")) + (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:" + "method1" "user1" "host1" + "method2" "user2" "host2" + "method3" "user3" "host3"))) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'method) + "method3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'user) + "user3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'host) + "host3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'hop) + (format "%s:%s@%s|%s:%s@%s|" + "method1" "user1" "host1" "method2" "user2" "host2"))))) + +(ert-deftest tramp-test03-file-name-defaults () + "Check default values for some methods." + ;; Default values in tramp-adb.el. + (should (string-equal (file-remote-p "/adb::" 'host) "")) + ;; Default values in tramp-ftp.el. + (should (string-equal (file-remote-p "/ftp.host:" 'method) "ftp")) + (dolist (u '("ftp" "anonymous")) + (should (string-equal (file-remote-p (format "/%s@:" u) 'method) "ftp"))) + ;; Default values in tramp-gvfs.el. + (when (and (load "tramp-gvfs" 'noerror 'nomessage) + (symbol-value 'tramp-gvfs-enabled)) + (should (string-equal (file-remote-p "/synce::" 'user) nil))) + ;; Default values in tramp-sh.el. + (dolist (h `("127.0.0.1" "[::1]" "localhost" "localhost6" ,(system-name))) + (should (string-equal (file-remote-p (format "/root@%s:" h) 'method) "su"))) + (dolist (m '("su" "sudo" "ksu")) + (should (string-equal (file-remote-p (format "/%s::" m) 'user) "root"))) + (dolist (m '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp")) + (should + (string-equal (file-remote-p (format "/%s::" m) 'user) (user-login-name)))) + ;; Default values in tramp-smb.el. + (should (string-equal (file-remote-p "/user%domain@host:" 'method) "smb")) + (should (string-equal (file-remote-p "/smb::" 'user) nil))) + +(ert-deftest tramp-test04-substitute-in-file-name () + "Check `substitute-in-file-name'." + (should (string-equal (substitute-in-file-name "/method:host://foo") "/foo")) + (should + (string-equal + (substitute-in-file-name "/method:host:/path//foo") "/method:host:/foo")) + (should + (string-equal (substitute-in-file-name "/method:host:/path///foo") "/foo")) + ;; Quoting local part. + (should + (string-equal + (substitute-in-file-name "/method:host:/://foo") "/method:host:/://foo")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path//foo") + "/method:host:/:/path//foo")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path///foo") + "/method:host:/:/path///foo")) + + (should + (string-equal + (substitute-in-file-name "/method:host:/path/~/foo") "/method:host:~/foo")) + (should + (string-equal (substitute-in-file-name "/method:host:/path//~/foo") "~/foo")) + ;; Quoting local part. + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path/~/foo") + "/method:host:/:/path/~/foo")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path//~/foo") + "/method:host:/:/path//~/foo")) + + (let (process-environment) + (should + (string-equal + (substitute-in-file-name "/method:host:/path/$FOO") + "/method:host:/path/$FOO")) + (setenv "FOO" "bla") + (should + (string-equal + (substitute-in-file-name "/method:host:/path/$FOO") + "/method:host:/path/bla")) + (should + (string-equal + (substitute-in-file-name "/method:host:/path/$$FOO") + "/method:host:/path/$FOO")) + ;; Quoting local part. + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path/$FOO") + "/method:host:/:/path/$FOO")) + (setenv "FOO" "bla") + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path/$FOO") + "/method:host:/:/path/$FOO")) + (should + (string-equal + (substitute-in-file-name "/method:host:/:/path/$$FOO") + "/method:host:/:/path/$$FOO")))) + +(ert-deftest tramp-test05-expand-file-name () + "Check `expand-file-name'." + (should + (string-equal + (expand-file-name "/method:host:/path/./file") "/method:host:/path/file")) + (should + (string-equal + (expand-file-name "/method:host:/path/../file") "/method:host:/file")) + ;; Quoting local part. + (should + (string-equal + (expand-file-name "/method:host:/:/path/./file") + "/method:host:/:/path/file")) + (should + (string-equal + (expand-file-name "/method:host:/:/path/../file") "/method:host:/:/file")) + (should + (string-equal + (expand-file-name "/method:host:/:/~/path/./file") + "/method:host:/:/~/path/file"))) + +(ert-deftest tramp-test06-directory-file-name () + "Check `directory-file-name'. +This checks also `file-name-as-directory', `file-name-directory', +`file-name-nondirectory' and `unhandled-file-name-directory'." + (should + (string-equal + (directory-file-name "/method:host:/path/to/file") + "/method:host:/path/to/file")) + (should + (string-equal + (directory-file-name "/method:host:/path/to/file/") + "/method:host:/path/to/file")) + (should + (string-equal + (file-name-as-directory "/method:host:/path/to/file") + "/method:host:/path/to/file/")) + (should + (string-equal + (file-name-as-directory "/method:host:/path/to/file/") + "/method:host:/path/to/file/")) + (should + (string-equal + (file-name-directory "/method:host:/path/to/file") + "/method:host:/path/to/")) + (should + (string-equal + (file-name-directory "/method:host:/path/to/file/") + "/method:host:/path/to/file/")) + (should + (string-equal (file-name-nondirectory "/method:host:/path/to/file") "file")) + (should + (string-equal (file-name-nondirectory "/method:host:/path/to/file/") "")) + (should-not + (unhandled-file-name-directory "/method:host:/path/to/file")) + + ;; Bug#10085. + (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled. + (dolist (n-e '(nil t)) + ;; We must clear `tramp-default-method'. On hydra, it is "ftp", + ;; which ruins the tests. + (let ((non-essential n-e) + tramp-default-method) + (dolist (file + `(,(file-remote-p tramp-test-temporary-file-directory 'method) + ,(file-remote-p tramp-test-temporary-file-directory 'host))) + (unless (zerop (length file)) + (setq file (format "/%s:" file)) + (should (string-equal (directory-file-name file) file)) + (should + (string-equal + (file-name-as-directory file) + (if (tramp-completion-mode-p) file (concat file "./")))) + (should (string-equal (file-name-directory file) file)) + (should (string-equal (file-name-nondirectory file) "")))))))) + +(ert-deftest tramp-test07-file-exists-p () + "Check `file-exist-p', `write-region' and `delete-file'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (should-not (file-exists-p tmp-name)) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (delete-file tmp-name) + (should-not (file-exists-p tmp-name))))) + +(ert-deftest tramp-test08-file-local-copy () + "Check `file-local-copy'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + tmp-name2) + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (setq tmp-name2 (file-local-copy tmp-name1))) + (with-temp-buffer + (insert-file-contents tmp-name2) + (should (string-equal (buffer-string) "foo"))) + ;; Check also that a file transfer with compression works. + (let ((default-directory tramp-test-temporary-file-directory) + (tramp-copy-size-limit 4) + (tramp-inline-compress-start-size 2)) + (delete-file tmp-name2) + (should (setq tmp-name2 (file-local-copy tmp-name1))))) + + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2)))))) + +(ert-deftest tramp-test09-insert-file-contents () + "Check `insert-file-contents'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (write-region "foo" nil tmp-name) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo")) + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foofoo")) + ;; Insert partly. + (insert-file-contents tmp-name nil 1 3) + (should (string-equal (buffer-string) "oofoofoo")) + ;; Replace. + (insert-file-contents tmp-name nil nil nil 'replace) + (should (string-equal (buffer-string) "foo")))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) + +(ert-deftest tramp-test10-write-region () + "Check `write-region'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (with-temp-buffer + (insert "foo") + (write-region nil nil tmp-name)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo"))) + ;; Append. + (with-temp-buffer + (insert "bla") + (write-region nil nil tmp-name 'append)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foobla"))) + ;; Write string. + (write-region "foo" nil tmp-name) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo"))) + ;; Write partly. + (with-temp-buffer + (insert "123456789") + (write-region 3 5 tmp-name)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "34")))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) + +(ert-deftest tramp-test11-copy-file () + "Check `copy-file'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (tramp--test-make-temp-name nil quoted)) + (tmp-name4 (tramp--test-make-temp-name 'local quoted)) + (tmp-name5 (tramp--test-make-temp-name 'local quoted))) + + ;; Copy on remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (copy-file tmp-name1 tmp-name2) + (should (file-exists-p tmp-name2)) + (with-temp-buffer + (insert-file-contents tmp-name2) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name1 tmp-name2)) + (copy-file tmp-name1 tmp-name2 'ok) + (make-directory tmp-name3) + (copy-file tmp-name1 tmp-name3) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)) + (ignore-errors (delete-directory tmp-name3 'recursive))) + + ;; Copy from remote side to local side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (copy-file tmp-name1 tmp-name4) + (should (file-exists-p tmp-name4)) + (with-temp-buffer + (insert-file-contents tmp-name4) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name1 tmp-name4)) + (copy-file tmp-name1 tmp-name4 'ok) + (make-directory tmp-name5) + (copy-file tmp-name1 tmp-name5) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name5 'recursive))) + + ;; Copy from local side to remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name4 nil 'nomessage) + (copy-file tmp-name4 tmp-name1) + (should (file-exists-p tmp-name1)) + (with-temp-buffer + (insert-file-contents tmp-name1) + (should (string-equal (buffer-string) "foo"))) + (should-error (copy-file tmp-name4 tmp-name1)) + (copy-file tmp-name4 tmp-name1 'ok) + (make-directory tmp-name3) + (copy-file tmp-name4 tmp-name3) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name3 'recursive)))))) + +(ert-deftest tramp-test12-rename-file () + "Check `rename-file'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (tramp--test-make-temp-name nil quoted)) + (tmp-name4 (tramp--test-make-temp-name 'local quoted)) + (tmp-name5 (tramp--test-make-temp-name 'local quoted))) + + ;; Rename on remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (rename-file tmp-name1 tmp-name2) + (should-not (file-exists-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (with-temp-buffer + (insert-file-contents tmp-name2) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name1) + (should-error (rename-file tmp-name1 tmp-name2)) + (rename-file tmp-name1 tmp-name2 'ok) + (should-not (file-exists-p tmp-name1)) + (write-region "foo" nil tmp-name1) + (make-directory tmp-name3) + (rename-file tmp-name1 tmp-name3) + (should-not (file-exists-p tmp-name1)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)) + (ignore-errors (delete-directory tmp-name3 'recursive))) + + ;; Rename from remote side to local side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (rename-file tmp-name1 tmp-name4) + (should-not (file-exists-p tmp-name1)) + (should (file-exists-p tmp-name4)) + (with-temp-buffer + (insert-file-contents tmp-name4) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name1) + (should-error (rename-file tmp-name1 tmp-name4)) + (rename-file tmp-name1 tmp-name4 'ok) + (should-not (file-exists-p tmp-name1)) + (write-region "foo" nil tmp-name1) + (make-directory tmp-name5) + (rename-file tmp-name1 tmp-name5) + (should-not (file-exists-p tmp-name1)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name5 'recursive))) + + ;; Rename from local side to remote side. + (unwind-protect + (progn + (write-region "foo" nil tmp-name4 nil 'nomessage) + (rename-file tmp-name4 tmp-name1) + (should-not (file-exists-p tmp-name4)) + (should (file-exists-p tmp-name1)) + (with-temp-buffer + (insert-file-contents tmp-name1) + (should (string-equal (buffer-string) "foo"))) + (write-region "foo" nil tmp-name4 nil 'nomessage) + (should-error (rename-file tmp-name4 tmp-name1)) + (rename-file tmp-name4 tmp-name1 'ok) + (should-not (file-exists-p tmp-name4)) + (write-region "foo" nil tmp-name4 nil 'nomessage) + (make-directory tmp-name3) + (rename-file tmp-name4 tmp-name3) + (should-not (file-exists-p tmp-name4)) + (should + (file-exists-p + (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name4)) + (ignore-errors (delete-directory tmp-name3 'recursive)))))) + +(ert-deftest tramp-test13-make-directory () + "Check `make-directory'. +This tests also `file-directory-p' and `file-accessible-directory-p'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "foo/bar" tmp-name1))) + (unwind-protect + (progn + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (should (file-accessible-directory-p tmp-name1)) + (should-error (make-directory tmp-name2)) + (make-directory tmp-name2 'parents) + (should (file-directory-p tmp-name2)) + (should (file-accessible-directory-p tmp-name2))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) + +(ert-deftest tramp-test14-delete-directory () + "Check `delete-directory'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + ;; Delete empty directory. + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (delete-directory tmp-name) + (should-not (file-directory-p tmp-name)) + ;; Delete non-empty directory. + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (write-region "foo" nil (expand-file-name "bla" tmp-name)) + (should (file-exists-p (expand-file-name "bla" tmp-name))) + (should-error (delete-directory tmp-name)) + (delete-directory tmp-name 'recursive) + (should-not (file-directory-p tmp-name))))) + +(ert-deftest tramp-test15-copy-directory () + "Check `copy-directory'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (expand-file-name + (file-name-nondirectory tmp-name1) tmp-name2)) + (tmp-name4 (expand-file-name "foo" tmp-name1)) + (tmp-name5 (expand-file-name "foo" tmp-name2)) + (tmp-name6 (expand-file-name "foo" tmp-name3))) + + ;; Copy complete directory. + (unwind-protect + (progn + ;; Copy empty directory. + (make-directory tmp-name1) + (write-region "foo" nil tmp-name4) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name4)) + (copy-directory tmp-name1 tmp-name2) + (should (file-directory-p tmp-name2)) + (should (file-exists-p tmp-name5)) + ;; Target directory does exist already. + (copy-directory tmp-name1 tmp-name2) + (should (file-directory-p tmp-name3)) + (should (file-exists-p tmp-name6))) + + ;; Cleanup. + (ignore-errors + (delete-directory tmp-name1 'recursive) + (delete-directory tmp-name2 'recursive))) + + ;; Copy directory contents. + (unwind-protect + (progn + ;; Copy empty directory. + (make-directory tmp-name1) + (write-region "foo" nil tmp-name4) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name4)) + (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents) + (should (file-directory-p tmp-name2)) + (should (file-exists-p tmp-name5)) + ;; Target directory does exist already. + (delete-file tmp-name5) + (should-not (file-exists-p tmp-name5)) + (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents) + (should (file-directory-p tmp-name2)) + (should (file-exists-p tmp-name5)) + (should-not (file-directory-p tmp-name3)) + (should-not (file-exists-p tmp-name6))) + + ;; Cleanup. + (ignore-errors + (delete-directory tmp-name1 'recursive) + (delete-directory tmp-name2 'recursive)))))) + +(ert-deftest tramp-test16-directory-files () + "Check `directory-files'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "bla" tmp-name1)) + (tmp-name3 (expand-file-name "foo" tmp-name1))) + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name2) + (write-region "bla" nil tmp-name3) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (should (file-exists-p tmp-name3)) + (should (equal (directory-files tmp-name1) '("." ".." "bla" "foo"))) + (should (equal (directory-files tmp-name1 'full) + `(,(concat tmp-name1 "/.") + ,(concat tmp-name1 "/..") + ,tmp-name2 ,tmp-name3))) + (should (equal (directory-files + tmp-name1 nil directory-files-no-dot-files-regexp) + '("bla" "foo"))) + (should (equal (directory-files + tmp-name1 'full directory-files-no-dot-files-regexp) + `(,tmp-name2 ,tmp-name3)))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) + +(ert-deftest tramp-test17-insert-directory () + "Check `insert-directory'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "foo" tmp-name1)) + ;; We test for the summary line. Keyword "total" could be localized. + (process-environment + (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment))) + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name2) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (with-temp-buffer + (insert-directory tmp-name1 nil) + (goto-char (point-min)) + (should (looking-at-p (regexp-quote tmp-name1)))) + (with-temp-buffer + (insert-directory tmp-name1 "-al") + (goto-char (point-min)) + (should + (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) + (with-temp-buffer + (insert-directory (file-name-as-directory tmp-name1) "-al") + (goto-char (point-min)) + (should + (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) + (with-temp-buffer + (insert-directory + (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) + (goto-char (point-min)) + (should + (looking-at-p + (concat + ;; There might be a summary line. + "\\(total.+[[:digit:]]+\n\\)?" + ;; We don't know in which order ".", ".." and "foo" appear. + "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}"))))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) + +(ert-deftest tramp-test18-file-attributes () + "Check `file-attributes'. +This tests also `file-readable-p', `file-regular-p' and +`file-ownership-preserved-p'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; We must use `file-truename' for the temporary directory, + ;; because it could be located on a symlinked directory. This + ;; would let the test fail. + (let* ((tramp-test-temporary-file-directory + (file-truename tramp-test-temporary-file-directory)) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + ;; File name with "//". + (tmp-name3 + (format + "%s%s" + (file-remote-p tmp-name1) + (replace-regexp-in-string + "/" "//" (file-remote-p tmp-name1 'localname)))) + attr) + (unwind-protect + (progn + ;; `file-ownership-preserved-p' should return t for + ;; non-existing files. It is implemented only in tramp-sh.el. + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (should (file-readable-p tmp-name1)) + (should (file-regular-p tmp-name1)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) + + ;; We do not test inodes and device numbers. + (setq attr (file-attributes tmp-name1)) + (should (consp attr)) + (should (null (car attr))) + (should (numberp (nth 1 attr))) ;; Link. + (should (numberp (nth 2 attr))) ;; Uid. + (should (numberp (nth 3 attr))) ;; Gid. + ;; Last access time. + (should (stringp (current-time-string (nth 4 attr)))) + ;; Last modification time. + (should (stringp (current-time-string (nth 5 attr)))) + ;; Last status change time. + (should (stringp (current-time-string (nth 6 attr)))) + (should (numberp (nth 7 attr))) ;; Size. + (should (stringp (nth 8 attr))) ;; Modes. + + (setq attr (file-attributes tmp-name1 'string)) + (should (stringp (nth 2 attr))) ;; Uid. + (should (stringp (nth 3 attr))) ;; Gid. + + (condition-case err + (progn + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name2 'group))) + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-exists-p tmp-name2)) + (should (file-symlink-p tmp-name2)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name2 'group))) + (setq attr (file-attributes tmp-name2)) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (car attr)) + (file-remote-p (file-truename tmp-name1) 'localname))) + (delete-file tmp-name2)) + (file-error + (should (string-equal (error-message-string err) + "make-symbolic-link not supported")))) + + ;; Check, that "//" in symlinks are handled properly. + (with-temp-buffer + (let ((default-directory tramp-test-temporary-file-directory)) + (shell-command + (format + "ln -s %s %s" + (tramp-file-name-localname + (tramp-dissect-file-name tmp-name3)) + (tramp-file-name-localname + (tramp-dissect-file-name tmp-name2))) + t))) + (when (file-symlink-p tmp-name2) + (setq attr (file-attributes tmp-name2)) + (should + (string-equal + (car attr) + (tramp-file-name-localname + (tramp-dissect-file-name tmp-name3)))) + (delete-file tmp-name2)) + + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) + (delete-file tmp-name1) + (make-directory tmp-name1) + (should (file-exists-p tmp-name1)) + (should (file-readable-p tmp-name1)) + (should-not (file-regular-p tmp-name1)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name1 'group))) + (setq attr (file-attributes tmp-name1)) + (should (eq (car attr) t))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1)) + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-file tmp-name2)))))) + +(ert-deftest tramp-test19-directory-files-and-attributes () + "Check `directory-files-and-attributes'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; `directory-files-and-attributes' contains also values for + ;; "../". Ensure that this doesn't change during tests, for + ;; example due to handling temporary files. + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "bla" tmp-name1)) + attr) + (unwind-protect + (progn + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (make-directory tmp-name2) + (should (file-directory-p tmp-name2)) + (write-region "foo" nil (expand-file-name "foo" tmp-name2)) + (write-region "bar" nil (expand-file-name "bar" tmp-name2)) + (write-region "boz" nil (expand-file-name "boz" tmp-name2)) + (setq attr (directory-files-and-attributes tmp-name2)) + (should (consp attr)) + ;; Dumb remote shells without perl(1) or stat(1) are not + ;; able to return the date correctly. They say "don't know". + (dolist (elt attr) + (unless + (equal + (nth + 5 (file-attributes (expand-file-name (car elt) tmp-name2))) + '(0 0)) + (should + (equal (file-attributes (expand-file-name (car elt) tmp-name2)) + (cdr elt))))) + (setq attr (directory-files-and-attributes tmp-name2 'full)) + (dolist (elt attr) + (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) + (should + (equal (file-attributes (car elt)) (cdr elt))))) + (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) + (should (equal (mapcar 'car attr) '("bar" "boz")))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) + +(ert-deftest tramp-test20-file-modes () + "Check `file-modes'. +This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (set-file-modes tmp-name #o777) + (should (= (file-modes tmp-name) #o777)) + (should (file-executable-p tmp-name)) + (should (file-writable-p tmp-name)) + (set-file-modes tmp-name #o444) + (should (= (file-modes tmp-name) #o444)) + (should-not (file-executable-p tmp-name)) + ;; A file is always writable for user "root". + (unless (zerop (nth 2 (file-attributes tmp-name))) + (should-not (file-writable-p tmp-name)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) + +(ert-deftest tramp-test21-file-links () + "Check `file-symlink-p'. +This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; We must use `file-truename' for the temporary directory, + ;; because it could be located on a symlinked directory. This + ;; would let the test fail. + (let* ((tramp-test-temporary-file-directory + (file-truename tramp-test-temporary-file-directory)) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (tramp--test-make-temp-name 'local quoted))) + + ;; Check `make-symbolic-link'. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + ;; Method "smb" supports `make-symbolic-link' only if the + ;; remote host has CIFS capabilities. tramp-adb.el and + ;; tramp-gvfs.el do not support symbolic links at all. + (condition-case err + (make-symbolic-link tmp-name1 tmp-name2) + (file-error + (skip-unless + (not (string-equal (error-message-string err) + "make-symbolic-link not supported"))))) + (should (file-symlink-p tmp-name2)) + (should-error (make-symbolic-link tmp-name1 tmp-name2)) + (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) + (should (file-symlink-p tmp-name2)) + ;; `tmp-name3' is a local file name. + (should-error (make-symbolic-link tmp-name1 tmp-name3))) + + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2))) + + ;; Check `add-name-to-file'. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (add-name-to-file tmp-name1 tmp-name2) + (should-not (file-symlink-p tmp-name2)) + (should-error (add-name-to-file tmp-name1 tmp-name2)) + (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) + (should-not (file-symlink-p tmp-name2)) + ;; `tmp-name3' is a local file name. + (should-error (add-name-to-file tmp-name1 tmp-name3))) + + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2))) + + ;; Check `file-truename'. + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name2)) + (should-not (string-equal tmp-name2 (file-truename tmp-name2))) + (should + (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) + (should (file-equal-p tmp-name1 tmp-name2))) + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2))) + + ;; `file-truename' shall preserve trailing link of directories. + (unless (file-symlink-p tramp-test-temporary-file-directory) + (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) + (dir2 (file-name-as-directory dir1))) + (should (string-equal (file-truename dir1) (expand-file-name dir1))) + (should + (string-equal (file-truename dir2) (expand-file-name dir2)))))))) + +(ert-deftest tramp-test22-file-times () + "Check `set-file-times' and `file-newer-than-file-p'." + (skip-unless (tramp--test-enabled)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) + (should (consp (nth 5 (file-attributes tmp-name1)))) + ;; '(0 0) means don't know, and will be replaced by + ;; `current-time'. Therefore, we use '(0 1). We skip the + ;; test, if the remote handler is not able to set the + ;; correct time. + (skip-unless (set-file-times tmp-name1 '(0 1))) + ;; Dumb remote shells without perl(1) or stat(1) are not + ;; able to return the date correctly. They say "don't know". + (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) + (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1))) + (write-region "bla" nil tmp-name2) + (should (file-exists-p tmp-name2)) + (should (file-newer-than-file-p tmp-name2 tmp-name1)) + ;; `tmp-name3' does not exist. + (should (file-newer-than-file-p tmp-name2 tmp-name3)) + (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))) + + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2)))))) + +(ert-deftest tramp-test23-visited-file-modtime () + "Check `set-visited-file-modtime' and `verify-visited-file-modtime'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (verify-visited-file-modtime)) + (set-visited-file-modtime '(0 1)) + (should (verify-visited-file-modtime)) + (should (equal (visited-file-modtime) '(0 1 0 0))))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) + +(ert-deftest tramp-test24-file-name-completion () + "Check `file-name-completion' and `file-name-all-completions'." + (skip-unless (tramp--test-enabled)) + + (dolist (n-e '(nil t)) + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((non-essential n-e) + (tmp-name (tramp--test-make-temp-name nil quoted)) + (method (file-remote-p tramp-test-temporary-file-directory 'method)) + (host (file-remote-p tramp-test-temporary-file-directory 'host))) + + (unwind-protect + (progn + ;; Method and host name in completion mode. This kind + ;; of completion does not work on MS Windows. + (when (and (tramp-completion-mode-p) + (not (memq system-type '(cygwin windows-nt)))) + (unless (zerop (length method)) + (should + (member + (format "%s:" method) + (file-name-all-completions (substring method 0 1) "/")))) + (unless (zerop (length host)) + (let ((tramp-default-method (or method tramp-default-method))) + (should + (member + (format "%s:" host) + (file-name-all-completions (substring host 0 1) "/"))))) + (unless (or (zerop (length method)) (zerop (length host))) + (should + (member + (format "%s:" host) + (file-name-all-completions + (substring host 0 1) (format "/%s:" method)))))) + + ;; Local files. + (make-directory tmp-name) + (should (file-directory-p tmp-name)) + (write-region "foo" nil (expand-file-name "foo" tmp-name)) + (should (file-exists-p (expand-file-name "foo" tmp-name))) + (write-region "bar" nil (expand-file-name "bold" tmp-name)) + (should (file-exists-p (expand-file-name "bold" tmp-name))) + (make-directory (expand-file-name "boz" tmp-name)) + (should (file-directory-p (expand-file-name "boz" tmp-name))) + (should (equal (file-name-completion "fo" tmp-name) "foo")) + (should (equal (file-name-completion "foo" tmp-name) t)) + (should (equal (file-name-completion "b" tmp-name) "bo")) + (should-not (file-name-completion "a" tmp-name)) + (should + (equal + (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) + (should + (equal (file-name-all-completions "fo" tmp-name) '("foo"))) + (should + (equal + (sort (file-name-all-completions "b" tmp-name) 'string-lessp) + '("bold" "boz/"))) + (should-not (file-name-all-completions "a" tmp-name)) + ;; `completion-regexp-list' restricts the completion to + ;; files which match all expressions in this list. + (let ((completion-regexp-list + `(,directory-files-no-dot-files-regexp "b"))) + (should + (equal (file-name-completion "" tmp-name) "bo")) + (should + (equal + (sort (file-name-all-completions "" tmp-name) 'string-lessp) + '("bold" "boz/")))) + ;; `file-name-completion' ignores file names that end in + ;; any string in `completion-ignored-extensions'. + (let ((completion-ignored-extensions '(".ext"))) + (write-region "foo" nil (expand-file-name "foo.ext" tmp-name)) + (should (file-exists-p (expand-file-name "foo.ext" tmp-name))) + (should (equal (file-name-completion "fo" tmp-name) "foo")) + (should (equal (file-name-completion "foo" tmp-name) t)) + (should + (equal (file-name-completion "foo." tmp-name) "foo.ext")) + (should (equal (file-name-completion "foo.ext" tmp-name) t)) + ;; `file-name-all-completions' is not affected. + (should + (equal + (sort (file-name-all-completions "" tmp-name) 'string-lessp) + '("../" "./" "bold" "boz/" "foo" "foo.ext"))))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name 'recursive))))))) + +(ert-deftest tramp-test25-load () + "Check `load'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (unwind-protect + (progn + (load tmp-name 'noerror 'nomessage) + (should-not (featurep 'tramp-test-load)) + (write-region "(provide 'tramp-test-load)" nil tmp-name) + ;; `load' in lread.c does not pass `must-suffix'. Why? + ;;(should-error + ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)) + (load tmp-name nil 'nomessage 'nosuffix) + (should (featurep 'tramp-test-load))) + + ;; Cleanup. + (ignore-errors + (and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load)) + (delete-file tmp-name)))))) + +(ert-deftest tramp-test26-process-file () + "Check `process-file'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) + (fnnd (file-name-nondirectory tmp-name)) + (default-directory tramp-test-temporary-file-directory) + kill-buffer-query-functions) + (unwind-protect + (progn + ;; We cannot use "/bin/true" and "/bin/false"; those paths + ;; do not exist on hydra. + (should (zerop (process-file "true"))) + (should-not (zerop (process-file "false"))) + (should-not (zerop (process-file "binary-does-not-exist"))) + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (should (zerop (process-file "ls" nil t nil fnnd))) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should (string-equal (format "%s\n" fnnd) (buffer-string))) + (should-not (get-buffer-window (current-buffer) t)) + + ;; Second run. The output must be appended. + (goto-char (point-max)) + (should (zerop (process-file "ls" nil t t fnnd))) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should + (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) + ;; A non-nil DISPLAY must not raise the buffer. + (should-not (get-buffer-window (current-buffer) t)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) + +(ert-deftest tramp-test27-start-file-process () + "Check `start-file-process'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((default-directory tramp-test-temporary-file-directory) + (tmp-name (tramp--test-make-temp-name nil quoted)) + kill-buffer-query-functions proc) + (unwind-protect + (with-temp-buffer + (setq proc (start-file-process "test1" (current-buffer) "cat")) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (process-send-string proc "foo") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors (delete-process proc))) + + (unwind-protect + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (setq proc + (start-file-process + "test2" (current-buffer) + "cat" (file-name-nondirectory tmp-name))) + (should (processp proc)) + ;; Read output. + (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors + (delete-process proc) + (delete-file tmp-name))) + + (unwind-protect + (with-temp-buffer + (setq proc (start-file-process "test3" (current-buffer) "cat")) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (set-process-filter + proc + (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) + (process-send-string proc "foo") + (process-send-eof proc) + ;; Read output. + (with-timeout (10 (ert-fail "`start-file-process' timed out")) + (while (< (- (point-max) (point-min)) (length "foo")) + (accept-process-output proc 0.1))) + (should (string-equal (buffer-string) "foo"))) + + ;; Cleanup. + (ignore-errors (delete-process proc)))))) + +(ert-deftest tramp-test28-shell-command () + "Check `shell-command'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted)) + (default-directory tramp-test-temporary-file-directory) + kill-buffer-query-functions) + (unwind-protect + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (shell-command + (format "ls %s" (file-name-nondirectory tmp-name)) + (current-buffer)) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name))) + + (unwind-protect + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (async-shell-command + (format "ls %s" (file-name-nondirectory tmp-name)) + (current-buffer)) + (set-process-sentinel (get-buffer-process (current-buffer)) nil) + ;; Read output. + (with-timeout (10 (ert-fail "`async-shell-command' timed out")) + (while (< (- (point-max) (point-min)) + (1+ (length (file-name-nondirectory tmp-name)))) + (accept-process-output + (get-buffer-process (current-buffer)) 0.1))) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + ;; There might be a nasty "Process *Async Shell* finished" message. + (goto-char (point-min)) + (forward-line) + (narrow-to-region (point-min) (point)) + (should + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name))) + + (unwind-protect + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (async-shell-command "read line; ls $line" (current-buffer)) + (set-process-sentinel (get-buffer-process (current-buffer)) nil) + (process-send-string + (get-buffer-process (current-buffer)) + (format "%s\n" (file-name-nondirectory tmp-name))) + ;; Read output. + (with-timeout (10 (ert-fail "`async-shell-command' timed out")) + (while (< (- (point-max) (point-min)) + (1+ (length (file-name-nondirectory tmp-name)))) + (accept-process-output + (get-buffer-process (current-buffer)) 0.1))) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + ;; There might be a nasty "Process *Async Shell* finished" message. + (goto-char (point-min)) + (forward-line) + (narrow-to-region (point-min) (point)) + (should + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name)))))) + +(defun tramp--test-shell-command-to-string-asynchronously (command) + "Like `shell-command-to-string', but for asynchronous processes." + (with-temp-buffer + (async-shell-command command (current-buffer)) + ;; Suppress nasty messages. + (set-process-sentinel (get-buffer-process (current-buffer)) nil) + (with-timeout (10) + (while (get-buffer-process (current-buffer)) + (accept-process-output (get-buffer-process (current-buffer)) 0.1))) + (accept-process-output nil 0.1) + (buffer-substring-no-properties (point-min) (point-max)))) + +;; This test is inspired by Bug#23952. +(ert-deftest tramp-test29-environment-variables () + "Check that remote processes set / unset environment variables properly." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (dolist (this-shell-command-to-string + '(;; Synchronously. + shell-command-to-string + ;; Asynchronously. + tramp--test-shell-command-to-string-asynchronously)) + + (let ((default-directory tramp-test-temporary-file-directory) + (shell-file-name "/bin/sh") + (envvar (concat "VAR_" (upcase (md5 (current-time-string))))) + kill-buffer-query-functions) + + (unwind-protect + ;; Set a value. + (let ((process-environment + (cons (concat envvar "=foo") process-environment))) + ;; Default value. + (should + (string-match + "foo" + (funcall + this-shell-command-to-string + (format "echo -n ${%s:?bla}" envvar)))))) + + (unwind-protect + ;; Set the empty value. + (let ((process-environment + (cons (concat envvar "=") process-environment))) + ;; Value is null. + (should + (string-match + "bla" + (funcall + this-shell-command-to-string + (format "echo -n ${%s:?bla}" envvar)))) + ;; Variable is set. + (should + (string-match + (regexp-quote envvar) + (funcall this-shell-command-to-string "set"))))) + + ;; We force a reconnect, in order to have a clean environment. + (tramp-cleanup-connection + (tramp-dissect-file-name tramp-test-temporary-file-directory) + 'keep-debug 'keep-password) + (unwind-protect + ;; Unset the variable. + (let ((tramp-remote-process-environment + (cons (concat envvar "=foo") + tramp-remote-process-environment))) + ;; Set the initial value, we want to unset below. + (should + (string-match + "foo" + (funcall + this-shell-command-to-string + (format "echo -n ${%s:?bla}" envvar)))) + (let ((process-environment + (cons envvar process-environment))) + ;; Variable is unset. + (should + (string-match + "bla" + (funcall + this-shell-command-to-string + (format "echo -n ${%s:?bla}" envvar)))) + ;; Variable is unset. + (should-not + (string-match + (regexp-quote envvar) + (funcall this-shell-command-to-string "set"))))))))) + +(ert-deftest tramp-test30-vc-registered () + "Check `vc-registered'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((default-directory tramp-test-temporary-file-directory) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "foo" tmp-name1)) + (tramp-remote-process-environment tramp-remote-process-environment) + (vc-handled-backends + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (cond + ((tramp-find-executable + v vc-git-program (tramp-get-remote-path v)) + '(Git)) + ((tramp-find-executable + v vc-hg-program (tramp-get-remote-path v)) + '(Hg)) + ((tramp-find-executable + v vc-bzr-program (tramp-get-remote-path v)) + (setq tramp-remote-process-environment + (cons (format "BZR_HOME=%s" + (file-remote-p tmp-name1 'localname)) + tramp-remote-process-environment)) + ;; We must force a reconnect, in order to activate $BZR_HOME. + (tramp-cleanup-connection + (tramp-dissect-file-name tramp-test-temporary-file-directory) + nil 'keep-password) + '(Bzr)) + (t nil))))) + (skip-unless vc-handled-backends) + (message "%s" vc-handled-backends) + + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name2) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (should-not (vc-registered tmp-name1)) + (should-not (vc-registered tmp-name2)) + + (let ((default-directory tmp-name1)) + ;; Create empty repository, and register the file. + ;; Sometimes, creation of repository fails (bzr!); we + ;; skip the test then. + (condition-case nil + (vc-create-repo (car vc-handled-backends)) + (error (skip-unless nil))) + ;; The structure of VC-FILESET is not documented. Let's + ;; hope it won't change. + (condition-case nil + (vc-register + (list (car vc-handled-backends) + (list (file-name-nondirectory tmp-name2)))) + ;; `vc-register' has changed its arguments in Emacs 25.1. + (error + (vc-register + nil (list (car vc-handled-backends) + (list (file-name-nondirectory tmp-name2)))))) + ;; vc-git uses an own process sentinel, Tramp's sentinel + ;; for flushing the cache isn't used. + (dired-uncache (concat (file-remote-p default-directory) "/")) + (should (vc-registered (file-name-nondirectory tmp-name2))))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)))))) + +(ert-deftest tramp-test31-make-auto-save-file-name () + "Check `make-auto-save-file-name'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name nil quoted))) + + (unwind-protect + (progn + ;; Use default `auto-save-file-name-transforms' mechanism. + (let (tramp-auto-save-directory) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from original `make-auto-save-file-name'. + (expand-file-name + (format + "#%s#" + (subst-char-in-string + ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + temporary-file-directory))))) + + ;; No mapping. + (let (tramp-auto-save-directory auto-save-file-name-transforms) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (expand-file-name + (format "#%s#" (file-name-nondirectory tmp-name1)) + tramp-test-temporary-file-directory)))))) + + ;; Use default `tramp-auto-save-directory' mechanism. + (let ((tramp-auto-save-directory tmp-name2)) + (with-temp-buffer + (setq buffer-file-name tmp-name1) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from Tramp. + (expand-file-name + (format + "#%s#" + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (tramp-compat-file-name-unquote tmp-name1))) + tmp-name2))) + (should (file-directory-p tmp-name2)))) + + ;; Relative file names shall work, too. + (let ((tramp-auto-save-directory ".")) + (with-temp-buffer + (setq buffer-file-name tmp-name1 + default-directory tmp-name2) + (should + (string-equal + (make-auto-save-file-name) + ;; This is taken from Tramp. + (expand-file-name + (format + "#%s#" + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (tramp-compat-file-name-unquote tmp-name1))) + tmp-name2))) + (should (file-directory-p tmp-name2))))) + + ;; Cleanup. + (ignore-errors (delete-file tmp-name1)) + (ignore-errors (delete-directory tmp-name2 'recursive)))))) + +;; The functions were introduced in Emacs 26.1. +(ert-deftest tramp-test32-make-nearby-temp-file () + "Check `make-nearby-temp-file' and `temporary-file-directory'." + (skip-unless (tramp--test-enabled)) + (skip-unless + (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory))) + + (let ((default-directory tramp-test-temporary-file-directory) + tmp-file) + ;; The remote host shall know a temporary file directory. + (should (stringp (temporary-file-directory))) + (should + (string-equal + (file-remote-p default-directory) + (file-remote-p (temporary-file-directory)))) + + ;; The temporary file shall be located on the remote host. + (setq tmp-file (make-nearby-temp-file "tramp-test")) + (should (file-exists-p tmp-file)) + (should (file-regular-p tmp-file)) + (should + (string-equal + (file-remote-p default-directory) + (file-remote-p tmp-file))) + (delete-file tmp-file) + (should-not (file-exists-p tmp-file)) + + (setq tmp-file (make-nearby-temp-file "tramp-test" 'dir)) + (should (file-exists-p tmp-file)) + (should (file-directory-p tmp-file)) + (delete-directory tmp-file) + (should-not (file-exists-p tmp-file)))) + +(defun tramp--test-adb-p () + "Check, whether the remote host runs Android. +This requires restrictions of file name syntax." + (tramp-adb-file-name-p tramp-test-temporary-file-directory)) + +(defun tramp--test-docker-p () + "Check, whether the docker method is used. +This does not support some special file names." + (string-equal + "docker" (file-remote-p tramp-test-temporary-file-directory 'method))) + +(defun tramp--test-ftp-p () + "Check, whether an FTP-like method is used. +This does not support globbing characters in file names (yet)." + ;; Globbing characters are ??, ?* and ?\[. + (string-match + "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method))) + +(defun tramp--test-gvfs-p () + "Check, whether the remote host runs a GVFS based method. +This requires restrictions of file name syntax." + (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)) + +(defun tramp--test-hpux-p () + "Check, whether the remote host runs HP-UX. +Several special characters do not work properly there." + ;; We must refill the cache. `file-truename' does it. + (with-parsed-tramp-file-name + (file-truename tramp-test-temporary-file-directory) nil + (string-match "^HP-UX" (tramp-get-connection-property v "uname" "")))) + +(defun tramp--test-rsync-p () + "Check, whether the rsync method is used. +This does not support special file names." + (string-equal + "rsync" (file-remote-p tramp-test-temporary-file-directory 'method))) + +(defun tramp--test-sh-p () + "Check, whether the remote host runs a based method from tramp-sh.el." + (eq + (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + 'tramp-sh-file-name-handler)) + +(defun tramp--test-windows-nt-and-batch () + "Check, whether the locale host runs MS Windows in batch mode. +This does not support special characters." + (and (eq system-type 'windows-nt) noninteractive)) + +(defun tramp--test-windows-nt-and-pscp-psftp-p () + "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used. +This does not support utf8 based file transfer." + (and (eq system-type 'windows-nt) + (string-match + (regexp-opt '("pscp" "psftp")) + (file-remote-p tramp-test-temporary-file-directory 'method)))) + +(defun tramp--test-windows-nt-or-smb-p () + "Check, whether the locale or remote host runs MS Windows. +This requires restrictions of file name syntax." + (or (eq system-type 'windows-nt) + (tramp-smb-file-name-p tramp-test-temporary-file-directory))) + +(defun tramp--test-check-files (&rest files) + "Run a simple but comprehensive test over every file in FILES." + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; We must use `file-truename' for the temporary directory, + ;; because it could be located on a symlinked directory. This + ;; would let the test fail. + (let* ((tramp-test-temporary-file-directory + (file-truename tramp-test-temporary-file-directory)) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name 'local quoted)) + (files (delq nil files)) + (process-environment process-environment)) + (unwind-protect + (progn + (make-directory tmp-name1) + (make-directory tmp-name2) + + (dolist (elt files) + (let* ((file1 (expand-file-name elt tmp-name1)) + (file2 (expand-file-name elt tmp-name2)) + (file3 (expand-file-name (concat elt "foo") tmp-name1))) + (write-region elt nil file1) + (should (file-exists-p file1)) + + ;; Check file contents. + (with-temp-buffer + (insert-file-contents file1) + (should (string-equal (buffer-string) elt))) + + ;; Copy file both directions. + (copy-file file1 tmp-name2) + (should (file-exists-p file2)) + (delete-file file1) + (should-not (file-exists-p file1)) + (copy-file file2 tmp-name1) + (should (file-exists-p file1)) + + ;; Method "smb" supports `make-symbolic-link' only if the + ;; remote host has CIFS capabilities. tramp-adb.el and + ;; tramp-gvfs.el do not support symbolic links at all. + (condition-case err + (progn + (make-symbolic-link file1 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (expand-file-name file1) (file-truename file3))) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (car (file-attributes file3))) + (file-remote-p (file-truename file1) 'localname))) + ;; Check file contents. + (with-temp-buffer + (insert-file-contents file3) + (should (string-equal (buffer-string) elt))) + (delete-file file3)) + (file-error + (should + (string-equal (error-message-string err) + "make-symbolic-link not supported")))))) + + ;; Check file names. + (should (equal (directory-files + tmp-name1 nil directory-files-no-dot-files-regexp) + (sort (copy-sequence files) 'string-lessp))) + (should (equal (directory-files + tmp-name2 nil directory-files-no-dot-files-regexp) + (sort (copy-sequence files) 'string-lessp))) + + ;; `substitute-in-file-name' could return different + ;; values. For `adb', there could be strange file + ;; permissions preventing overwriting a file. We don't + ;; care in this testcase. + (dolist (elt files) + (let ((file1 + (substitute-in-file-name (expand-file-name elt tmp-name1))) + (file2 + (substitute-in-file-name + (expand-file-name elt tmp-name2)))) + (ignore-errors (write-region elt nil file1)) + (should (file-exists-p file1)) + (ignore-errors (write-region elt nil file2 nil 'nomessage)) + (should (file-exists-p file2)))) + + (should (equal (directory-files + tmp-name1 nil directory-files-no-dot-files-regexp) + (directory-files + tmp-name2 nil directory-files-no-dot-files-regexp))) + + ;; Check directory creation. We use a subdirectory "foo" + ;; in order to avoid conflicts with previous file name tests. + (dolist (elt files) + (let* ((elt1 (concat elt "foo")) + (file1 (expand-file-name (concat "foo/" elt) tmp-name1)) + (file2 (expand-file-name elt file1)) + (file3 (expand-file-name elt1 file1))) + (make-directory file1 'parents) + (should (file-directory-p file1)) + (write-region elt nil file2) + (should (file-exists-p file2)) + (should + (equal + (directory-files + file1 nil directory-files-no-dot-files-regexp) + `(,elt))) + (should + (equal + (caar (directory-files-and-attributes + file1 nil directory-files-no-dot-files-regexp)) + elt)) + + ;; Check symlink in `directory-files-and-attributes'. + (condition-case err + (progn + (make-symbolic-link file2 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (caar (directory-files-and-attributes + file1 nil (regexp-quote elt1))) + elt1)) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (cadr (car (directory-files-and-attributes + file1 nil (regexp-quote elt1))))) + (file-remote-p (file-truename file2) 'localname))) + (delete-file file3) + (should-not (file-exists-p file3))) + (file-error + (should (string-equal (error-message-string err) + "make-symbolic-link not supported")))) + + (delete-file file2) + (should-not (file-exists-p file2)) + (delete-directory file1) + (should-not (file-exists-p file1)))) + + ;; Check, that environment variables are set correctly. + (when (and tramp--test-expensive-test (tramp--test-sh-p)) + (dolist (elt files) + (let ((envvar (concat "VAR_" (upcase (md5 elt)))) + (default-directory tramp-test-temporary-file-directory) + (process-environment process-environment)) + (setenv envvar elt) + ;; The value of PS1 could confuse Tramp's detection + ;; of process output. So we unset it temporarily. + (setenv "PS1") + (with-temp-buffer + (should (zerop (process-file "env" nil t nil))) + (goto-char (point-min)) + (should + (re-search-forward + (format + "^%s=%s$" + (regexp-quote envvar) + (regexp-quote (getenv envvar)))))))))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive)) + (ignore-errors (delete-directory tmp-name2 'recursive)))))) + +(defun tramp--test-special-characters () + "Perform the test in `tramp-test33-special-characters*'." + ;; Newlines, slashes and backslashes in file names are not + ;; supported. So we don't test. And we don't test the tab + ;; character on Windows or Cygwin, because the backslash is + ;; interpreted as a path separator, preventing "\t" from being + ;; expanded to <TAB>. + (tramp--test-check-files + (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + "foo bar baz" + (if (or (tramp--test-adb-p) + (tramp--test-docker-p) + (eq system-type 'cygwin)) + " foo bar baz " + " foo\tbar baz\t")) + "$foo$bar$$baz$" + "-foo-bar-baz-" + "%foo%bar%baz%" + "&foo&bar&baz&" + (unless (or (tramp--test-ftp-p) + (tramp--test-gvfs-p) + (tramp--test-windows-nt-or-smb-p)) + "?foo?bar?baz?") + (unless (or (tramp--test-ftp-p) + (tramp--test-gvfs-p) + (tramp--test-windows-nt-or-smb-p)) + "*foo*bar*baz*") + (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + "'foo'bar'baz'" + "'foo\"bar'baz\"") + "#foo~bar#baz~" + (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + "!foo!bar!baz!" + "!foo|bar!baz|") + (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + ";foo;bar;baz;" + ":foo;bar:baz;") + (unless (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) + "<foo>bar<baz>") + "(foo)bar(baz)" + (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p)) "[foo]bar[baz]") + "{foo}bar{baz}")) + +;; These tests are inspired by Bug#17238. +(ert-deftest tramp-test33-special-characters () + "Check special characters in file names." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-rsync-p))) + (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) + + (tramp--test-special-characters)) + +(ert-deftest tramp-test33-special-characters-with-stat () + "Check special characters in file names. +Use the `stat' command." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-rsync-p))) + (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (skip-unless (tramp-get-remote-stat v))) + + (let ((tramp-connection-properties + (append + `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "perl" nil)) + tramp-connection-properties))) + (tramp--test-special-characters))) + +(ert-deftest tramp-test33-special-characters-with-perl () + "Check special characters in file names. +Use the `perl' command." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-rsync-p))) + (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (skip-unless (tramp-get-remote-perl v))) + + (let ((tramp-connection-properties + (append + `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "stat" nil) + ;; See `tramp-sh-handle-file-truename'. + (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "readlink" nil)) + tramp-connection-properties))) + (tramp--test-special-characters))) + +(ert-deftest tramp-test33-special-characters-with-ls () + "Check special characters in file names. +Use the `ls' command." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-rsync-p))) + (skip-unless (not (tramp--test-windows-nt-and-batch))) + (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) + + (let ((tramp-connection-properties + (append + `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "perl" nil) + (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "stat" nil) + ;; See `tramp-sh-handle-file-truename'. + (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "readlink" nil)) + tramp-connection-properties))) + (tramp--test-special-characters))) + +(defun tramp--test-utf8 () + "Perform the test in `tramp-test34-utf8*'." + (let* ((utf8 (if (and (eq system-type 'darwin) + (memq 'utf-8-hfs (coding-system-list))) + 'utf-8-hfs 'utf-8)) + (coding-system-for-read utf8) + (coding-system-for-write utf8) + (file-name-coding-system utf8)) + (tramp--test-check-files + (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") + (unless (tramp--test-hpux-p) + "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") + "银河系漫游指南系列" + "Автостопом по гала́ктике"))) + +(ert-deftest tramp-test34-utf8 () + "Check UTF8 encoding in file names and file contents." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-docker-p))) + (skip-unless (not (tramp--test-rsync-p))) + (skip-unless (not (tramp--test-windows-nt-and-batch))) + (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) + + (tramp--test-utf8)) + +(ert-deftest tramp-test34-utf8-with-stat () + "Check UTF8 encoding in file names and file contents. +Use the `stat' command." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-docker-p))) + (skip-unless (not (tramp--test-rsync-p))) + (skip-unless (not (tramp--test-windows-nt-and-batch))) + (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (skip-unless (tramp-get-remote-stat v))) + + (let ((tramp-connection-properties + (append + `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "perl" nil)) + tramp-connection-properties))) + (tramp--test-utf8))) + +(ert-deftest tramp-test34-utf8-with-perl () + "Check UTF8 encoding in file names and file contents. +Use the `perl' command." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-docker-p))) + (skip-unless (not (tramp--test-rsync-p))) + (skip-unless (not (tramp--test-windows-nt-and-batch))) + (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) + (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil + (skip-unless (tramp-get-remote-perl v))) + + (let ((tramp-connection-properties + (append + `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "stat" nil) + ;; See `tramp-sh-handle-file-truename'. + (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "readlink" nil)) + tramp-connection-properties))) + (tramp--test-utf8))) + +(ert-deftest tramp-test34-utf8-with-ls () + "Check UTF8 encoding in file names and file contents. +Use the `ls' command." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-docker-p))) + (skip-unless (not (tramp--test-rsync-p))) + (skip-unless (not (tramp--test-windows-nt-and-batch))) + (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p))) + + (let ((tramp-connection-properties + (append + `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "perl" nil) + (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "stat" nil) + ;; See `tramp-sh-handle-file-truename'. + (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) + "readlink" nil)) + tramp-connection-properties))) + (tramp--test-utf8))) + +;; This test is inspired by Bug#16928. +(ert-deftest tramp-test35-asynchronous-requests () + "Check parallel asynchronous requests. +Such requests could arrive from timers, process filters and +process sentinels. They shall not disturb each other." + ;; Mark as failed until bug has been fixed. + :expected-result :failed + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + ;; Keep instrumentation verbosity 0 until Tramp bug is fixed. + ;; This has the side effect, that this test fails instead to + ;; abort. Good for hydra. + (tramp--instrument-test-case 0 + (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) + (default-directory tmp-name) + (remote-file-name-inhibit-cache t) + timer buffers kill-buffer-query-functions) + + (unwind-protect + (progn + (make-directory tmp-name) + + ;; Setup a timer in order to raise an ordinary command + ;; again and again. `vc-registered' is well suited, + ;; because there are many checks. + (setq + timer + (run-at-time + 0 1 + (lambda () + (when buffers + (vc-registered + (buffer-name (nth (random (length buffers)) buffers))))))) + + ;; Create temporary buffers. The number of buffers + ;; corresponds to the number of processes; it could be + ;; increased in order to make pressure on Tramp. + (dotimes (i 5) + (add-to-list 'buffers (generate-new-buffer "*temp*"))) + + ;; Open asynchronous processes. Set process sentinel. + (dolist (buf buffers) + (async-shell-command "read line; touch $line; echo $line" buf) + (set-process-sentinel + (get-buffer-process buf) + (lambda (proc _state) + (delete-file (buffer-name (process-buffer proc)))))) + + ;; Send a string. Use a random order of the buffers. Mix + ;; with regular operation. + (let ((buffers (copy-sequence buffers)) + buf) + (while buffers + (setq buf (nth (random (length buffers)) buffers)) + (process-send-string + (get-buffer-process buf) (format "'%s'\n" buf)) + (file-attributes (buffer-name buf)) + (setq buffers (delq buf buffers)))) + + ;; Wait until the whole output has been read. + (with-timeout ((* 10 (length buffers)) + (ert-fail "`async-shell-command' timed out")) + (let ((buffers (copy-sequence buffers)) + buf) + (while buffers + (setq buf (nth (random (length buffers)) buffers)) + (if (ignore-errors + (memq (process-status (get-buffer-process buf)) + '(run open))) + (accept-process-output (get-buffer-process buf) 0.1) + (setq buffers (delq buf buffers)))))) + + ;; Check. + (dolist (buf buffers) + (with-current-buffer buf + (should + (string-equal (format "'%s'\n" buf) (buffer-string))))) + (should-not + (directory-files + tmp-name nil directory-files-no-dot-files-regexp))) + + ;; Cleanup. + (ignore-errors (cancel-timer timer)) + (ignore-errors (delete-directory tmp-name 'recursive)) + (dolist (buf buffers) + (ignore-errors (kill-buffer buf)))))))) + +(ert-deftest tramp-test36-recursive-load () + "Check that Tramp does not fail due to recursive load." + (skip-unless (tramp--test-enabled)) + + (dolist (code + (list + (format "(expand-file-name %S)" tramp-test-temporary-file-directory) + (format + "(let ((default-directory %S)) (expand-file-name %S))" + tramp-test-temporary-file-directory + temporary-file-directory))) + (should-not + (string-match + "Recursive load" + (shell-command-to-string + (format + "%s -batch -Q -L %s --eval %s" + (expand-file-name invocation-name invocation-directory) + (mapconcat 'shell-quote-argument load-path " -L ") + (shell-quote-argument code))))))) + +(ert-deftest tramp-test37-unload () + "Check that Tramp and its subpackages unload completely. +Since it unloads Tramp, it shall be the last test to run." + ;; Mark as failed until all symbols are unbound. + :expected-result (if (featurep 'tramp) :failed :passed) + :tags '(:expensive-test) + (when (featurep 'tramp) + (unload-feature 'tramp 'force) + ;; No Tramp feature must be left. + (should-not (featurep 'tramp)) + (should-not (all-completions "tramp" (delq 'tramp-tests features))) + ;; `file-name-handler-alist' must be clean. + (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) + ;; There shouldn't be left a bound symbol. We do not regard our + ;; test symbols, and the Tramp unload hooks. + (mapatoms + (lambda (x) + (and (or (boundp x) (functionp x)) + (string-match "^tramp" (symbol-name x)) + (not (string-match "^tramp--?test" (symbol-name x))) + (not (string-match "unload-hook$" (symbol-name x))) + (ert-fail (format "`%s' still bound" x))))) + ;; There shouldn't be left a hook function containing a Tramp + ;; function. We do not regard the Tramp unload hooks. + (mapatoms + (lambda (x) + (and (boundp x) + (string-match "-hooks?$" (symbol-name x)) + (not (string-match "unload-hook$" (symbol-name x))) + (consp (symbol-value x)) + (ignore-errors (all-completions "tramp" (symbol-value x))) + (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) + +;; TODO: + +;; * dired-compress-file +;; * dired-uncache +;; * file-acl +;; * file-name-case-insensitive-p +;; * file-selinux-context +;; * find-backup-file-name +;; * set-file-acl +;; * set-file-selinux-context + +;; * Work on skipped tests. Make a comment, when it is impossible. +;; * Fix `tramp-test06-directory-file-name' for `ftp'. +;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). +;; * Fix Bug#16928. Set expected error of `tramp-test35-asynchronous-requests'. +;; * Fix `tramp-test37-unload' (Not all symbols are unbound). Set +;; expected error. + +(defun tramp-test-all (&optional interactive) + "Run all tests for \\[tramp]." + (interactive "p") + (funcall + (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp")) + +(provide 'tramp-tests) +;;; tramp-tests.el ends here diff --git a/test/automated/obarray-tests.el b/test/lisp/obarray-tests.el index 92345b7198e..92345b7198e 100644 --- a/test/automated/obarray-tests.el +++ b/test/lisp/obarray-tests.el diff --git a/test/lisp/progmodes/cc-mode-tests.el b/test/lisp/progmodes/cc-mode-tests.el new file mode 100644 index 00000000000..62e0a738fbd --- /dev/null +++ b/test/lisp/progmodes/cc-mode-tests.el @@ -0,0 +1,72 @@ +;;; cc-mode-tests.el --- Test suite for cc-mode. -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Michal Nazarewicz <mina86@mina86.com> +;; Keywords: internal +;; Human-Keywords: internal + +;; 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 <http://www.gnu.org/licenses/>. + + +;;; Commentary: + +;; Unit tests for cc-mode.el. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'cc-mode) + +(ert-deftest c-or-c++-mode () + "Test c-or-c++-mode language detection." + (cl-letf* ((mode nil) + (do-test (lambda (content expected) + (delete-region (point-min) (point-max)) + (insert content) + (setq mode nil) + (c-or-c++-mode) + (unless(eq expected mode) + (ert-fail + (format "expected %s but got %s when testing '%s'" + expected mode content))))) + ((symbol-function 'c-mode) (lambda () (setq mode 'c-mode))) + ((symbol-function 'c++-mode) (lambda () (setq mode 'c++-mode)))) + (with-temp-buffer + (mapc (lambda (content) + (funcall do-test content 'c++-mode) + (funcall do-test (concat "// " content) 'c-mode) + (funcall do-test (concat " * " content) 'c-mode)) + '("using \t namespace \t std;" + "using \t std::string;" + "namespace \t {" + "namespace \t foo \t {" + "class \t Blah_42 \t {" + "class \t Blah_42 \t \n" + "class \t _42_Blah:public Foo {" + "template \t < class T >" + "template< class T >" + "#include <string>" + "#include<iostream>" + "#include \t <map>")) + + (mapc (lambda (content) (funcall do-test content 'c-mode)) + '("struct \t Blah_42 \t {" + "struct template {" + "#include <string.h>"))))) + +;;; cc-mode-tests.el ends here diff --git a/test/automated/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 6821a6bfae5..9f61c20fd5e 100644 --- a/test/automated/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -1,4 +1,4 @@ -;;; compile-tests.el --- Test suite for font parsing. +;;; compile-tests.el --- Test suite for compile.el. -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -21,6 +21,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;; Commentary: + +;; Unit tests for lisp/progmodes/compile.el. + ;;; Code: (require 'ert) @@ -79,6 +83,16 @@ 1 nil 302 "\\lib\\python\\Products\\PythonScripts\\PythonScript.py") ("File \"/tmp/foo.py\", line 10" 1 nil 10 "/tmp/foo.py") + ;; 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):" + 1 nil 23 "CMakeLists.txt") + ("CMake Warning at cmake/modules/UseUG.cmake:73 (find_package):" + 1 nil 73 "cmake/modules/UseUG.cmake") + (" 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" 1 nil 3 "foo.f") @@ -316,15 +330,18 @@ ("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), 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, and FILENAME is the reported filename. +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. 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) meaning a range of columns starting on LINE and ending on -END-LINE, if that matched.") +END-LINE, if that matched. TYPE can be left out, in which case +any message type is accepted.") (defun compile--test-error-line (test) (erase-buffer) @@ -332,35 +349,34 @@ END-LINE, if that matched.") (insert (car test)) (compilation-parse-errors (point-min) (point-max)) (let ((msg (get-text-property (nth 1 test) 'compilation-message))) - (when 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))) - (and (equal (compilation--loc->col loc) col) - (equal (compilation--loc->line loc) line) - (or (not file) - (equal (caar (compilation--loc->file-struct loc)) file)) - (or (null end-col) - (equal (car (cadr (nth 2 (compilation--loc->file-struct loc)))) - end-col)) - (equal (car (nth 2 (compilation--loc->file-struct loc))) - (or end-line line)) - (or (null type) - (equal type (compilation--message->type msg)))))))) + (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-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) - (dolist (test compile-tests--test-regexps-data) - (should (compile--test-error-line test))))) + (mapc #'compile--test-error-line compile-tests--test-regexps-data))) -;;; compile-tests.el ends here. +;;; compile-tests.el ends here diff --git a/test/automated/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index f3f15ad3dbd..12e61cf8d18 100644 --- a/test/automated/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -244,7 +244,7 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(cl-defstruct (xref-elisp-location (:constructor xref-make-elisp-location)))" (xref-make-elisp-location 'xref-elisp-location 'define-type - (expand-file-name "../../lisp/progmodes/elisp-mode.el" emacs-test-dir))) + (expand-file-name "../../../lisp/progmodes/elisp-mode.el" emacs-test-dir))) ;; It's not worth adding another special case to `xref-elisp-test-descr-to-target' for this "(cl-defstruct (xref-elisp-location") )) @@ -255,11 +255,11 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(defalias Buffer-menu-sort)" (xref-make-elisp-location 'Buffer-menu-sort 'defalias - (expand-file-name "../../lisp/buff-menu.elc" emacs-test-dir))) + (expand-file-name "../../../lisp/buff-menu.elc" emacs-test-dir))) (xref-make "(defun tabulated-list-sort)" (xref-make-elisp-location 'tabulated-list-sort nil - (expand-file-name "../../lisp/emacs-lisp/tabulated-list.el" emacs-test-dir))) + (expand-file-name "../../../lisp/emacs-lisp/tabulated-list.el" emacs-test-dir))) )) ;; FIXME: defconst @@ -347,7 +347,9 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type) arg2))" (xref-make-elisp-location - '(xref-elisp-generic-no-default xref-elisp-root-type t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-no-default nil '(xref-elisp-root-type t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) )) @@ -360,7 +362,10 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type) arg2))" (xref-make-elisp-location - '(xref-elisp-generic-co-located-default xref-elisp-root-type t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-co-located-default nil + '(xref-elisp-root-type t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) )) @@ -373,11 +378,16 @@ to (xref-elisp-test-descr-to-target xref)." (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-separate-default (arg1 arg2))" (xref-make-elisp-location - '(xref-elisp-generic-separate-default t t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-separate-default nil '(t t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type) arg2))" (xref-make-elisp-location - '(xref-elisp-generic-separate-default xref-elisp-root-type t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-separate-default nil + '(xref-elisp-root-type t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) )) @@ -386,11 +396,16 @@ to (xref-elisp-test-descr-to-target xref)." (list (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic (arg1 arg2))" (xref-make-elisp-location - '(xref-elisp-generic-implicit-generic t t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-implicit-generic nil '(t t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type) arg2))" (xref-make-elisp-location - '(xref-elisp-generic-implicit-generic xref-elisp-root-type t) 'cl-defmethod + (cl--generic-load-hist-format + 'xref-elisp-generic-implicit-generic nil + '(xref-elisp-root-type t)) + 'cl-defmethod (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) )) @@ -406,27 +421,37 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(cl-defgeneric xref-location-marker)" (xref-make-elisp-location 'xref-location-marker 'cl-defgeneric - (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) + (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-elisp-location)))" (xref-make-elisp-location - '(xref-location-marker xref-elisp-location) 'cl-defmethod - (expand-file-name "../../lisp/progmodes/elisp-mode.el" emacs-test-dir))) + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-elisp-location)) + 'cl-defmethod + (expand-file-name "../../../lisp/progmodes/elisp-mode.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-file-location)))" (xref-make-elisp-location - '(xref-location-marker xref-file-location) 'cl-defmethod - (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-file-location)) + 'cl-defmethod + (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-buffer-location)))" (xref-make-elisp-location - '(xref-location-marker xref-buffer-location) 'cl-defmethod - (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-buffer-location)) + 'cl-defmethod + (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-bogus-location)))" (xref-make-elisp-location - '(xref-location-marker xref-bogus-location) 'cl-defmethod - (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-bogus-location)) + 'cl-defmethod + (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-etags-location)))" (xref-make-elisp-location - '(xref-location-marker xref-etags-location) 'cl-defmethod - (expand-file-name "../../lisp/progmodes/etags.el" emacs-test-dir))) + (cl--generic-load-hist-format + 'xref-location-marker nil '(xref-etags-location)) + 'cl-defmethod + (expand-file-name "../../../lisp/progmodes/etags.el" emacs-test-dir))) )) (xref-elisp-deftest find-defs-defgeneric-eval @@ -528,7 +553,7 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(defun xref-find-definitions)" (xref-make-elisp-location 'xref-find-definitions nil - (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))))) + (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 ()))) @@ -561,7 +586,7 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(defun abbrev-mode)" (xref-make-elisp-location 'abbrev-mode nil - (expand-file-name "../../lisp/abbrev.el" emacs-test-dir))) + (expand-file-name "../../../lisp/abbrev.el" emacs-test-dir))) "(define-minor-mode abbrev-mode")) ) @@ -582,7 +607,7 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(defun compilation-minor-mode)" (xref-make-elisp-location 'compilation-minor-mode nil - (expand-file-name "../../lisp/progmodes/compile.el" emacs-test-dir))) + (expand-file-name "../../../lisp/progmodes/compile.el" emacs-test-dir))) "(define-minor-mode compilation-minor-mode") )) @@ -592,7 +617,7 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(defvar xref--marker-ring)" (xref-make-elisp-location 'xref--marker-ring 'defvar - (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) + (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) )) (xref-elisp-deftest find-defs-defvar-c @@ -615,11 +640,11 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(defvar font-lock-keyword-face)" (xref-make-elisp-location 'font-lock-keyword-face 'defvar - (expand-file-name "../../lisp/font-lock.el" emacs-test-dir))) + (expand-file-name "../../../lisp/font-lock.el" emacs-test-dir))) (xref-make "(defface font-lock-keyword-face)" (xref-make-elisp-location 'font-lock-keyword-face 'defface - (expand-file-name "../../lisp/font-lock.el" emacs-test-dir))) + (expand-file-name "../../../lisp/font-lock.el" emacs-test-dir))) )) (xref-elisp-deftest find-defs-face-eval @@ -633,7 +658,7 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make "(feature xref)" (xref-make-elisp-location 'xref 'feature - (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) + (expand-file-name "../../../lisp/progmodes/xref.el" emacs-test-dir))) ";;; Code:") )) @@ -641,5 +666,11 @@ to (xref-elisp-test-descr-to-target xref)." (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature))) nil) +(ert-deftest elisp--preceding-sexp--char-name () + (with-temp-buffer + (emacs-lisp-mode) + (insert "?\\N{HEAVY CHECK MARK}") + (should (equal (elisp--preceding-sexp) ?\N{HEAVY CHECK MARK})))) + (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 new file mode 100644 index 00000000000..a992a17dc46 --- /dev/null +++ b/test/lisp/progmodes/etags-tests.el @@ -0,0 +1,91 @@ +;;; etags-tests.el --- Test suite for etags.el. + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Eli Zaretskii <eliz@gnu.org> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'etags) + +(defvar his-masters-voice t) + +(defun y-or-n-p (_prompt) + "Replacement for `y-or-n-p' that returns what we tell it to." + his-masters-voice) + +(ert-deftest etags-bug-158 () + "Test finding tags with local and global tags tables." + (let ((buf-with-global-tags (get-buffer-create "*buf-global*")) + (buf-with-local-tags (get-buffer-create "*buf-local*")) + xref-buf) + (set-buffer buf-with-global-tags) + (setq default-directory (expand-file-name ".")) + (visit-tags-table + (expand-file-name "manual/etags/ETAGS.good_1" + (getenv "EMACS_TEST_DIRECTORY"))) + ;; Check that tags in ETAGS.good_1 are recognized. + (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t")) + (should (bufferp xref-buf)) + (kill-buffer xref-buf) + (setq xref-buf (xref-find-definitions "PrintAdd")) + (should (bufferp xref-buf)) + (kill-buffer xref-buf) + ;; Check that tags not in ETAGS.good_1, but in ETAGS.good_3, are + ;; NOT recognized. + (should-error (xref-find-definitions "intNumber") :type 'user-error) + (kill-buffer xref-buf) + (set-buffer buf-with-local-tags) + (setq default-directory (expand-file-name ".")) + (let (his-masters-voice) + (visit-tags-table + (expand-file-name "manual/etags/ETAGS.good_3" + (getenv "EMACS_TEST_DIRECTORY")) + t)) + ;; Check that tags in ETAGS.good_1 are recognized. + (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t")) + (should (bufferp xref-buf)) + (kill-buffer xref-buf) + (setq xref-buf (xref-find-definitions "PrintAdd")) + (should (bufferp xref-buf)) + (kill-buffer xref-buf) + ;; Check that tags in ETAGS.good_3 are recognized. This is a test + ;; for bug#158. + (setq xref-buf (xref-find-definitions "intNumber")) + (should (or (null xref-buf) + (bufferp xref-buf))) + ;; Bug #17326 + (should (string= (file-name-nondirectory + (buffer-local-value 'tags-file-name buf-with-local-tags)) + "ETAGS.good_3")) + (should (string= (file-name-nondirectory + (default-value 'tags-file-name)) + "ETAGS.good_1")) + (if (bufferp xref-buf) (kill-buffer xref-buf)))) + +(ert-deftest etags-bug-23164 () + "Test that setting a local value of tags table doesn't signal errors." + (set-buffer (get-buffer-create "*foobar*")) + (fundamental-mode) + (visit-tags-table + (expand-file-name "manual/etags/ETAGS.good_3" + (getenv "EMACS_TEST_DIRECTORY")) + t) + (should (equal (should-error (xref-find-definitions "foobar123")) + '(user-error "No definitions found for: foobar123")))) diff --git a/test/automated/f90.el b/test/lisp/progmodes/f90.el index 29c608847f1..29c608847f1 100644 --- a/test/automated/f90.el +++ b/test/lisp/progmodes/f90.el diff --git a/test/automated/data/flymake/Makefile b/test/lisp/progmodes/flymake-resources/Makefile index 0f3f39791c8..0f3f39791c8 100644 --- a/test/automated/data/flymake/Makefile +++ b/test/lisp/progmodes/flymake-resources/Makefile diff --git a/test/automated/data/flymake/test.c b/test/lisp/progmodes/flymake-resources/test.c index 3a3926131f5..3a3926131f5 100644 --- a/test/automated/data/flymake/test.c +++ b/test/lisp/progmodes/flymake-resources/test.c diff --git a/test/automated/data/flymake/test.pl b/test/lisp/progmodes/flymake-resources/test.pl index d5abcb47e7f..d5abcb47e7f 100644 --- a/test/automated/data/flymake/test.pl +++ b/test/lisp/progmodes/flymake-resources/test.pl diff --git a/test/automated/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index f3b830d3654..386516190bb 100644 --- a/test/automated/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -26,7 +26,7 @@ (require 'flymake) (defvar flymake-tests-data-directory - (expand-file-name "data/flymake" (getenv "EMACS_TEST_DIRECTORY")) + (expand-file-name "lisp/progmodes/flymake-resources" (getenv "EMACS_TEST_DIRECTORY")) "Directory containing flymake test data.") diff --git a/test/automated/python-tests.el b/test/lisp/progmodes/python-tests.el index f6564dd58cc..f6564dd58cc 100644 --- a/test/automated/python-tests.el +++ b/test/lisp/progmodes/python-tests.el diff --git a/test/automated/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index 52126a3bdf1..97f277bff41 100644 --- a/test/automated/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el @@ -716,6 +716,17 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby-backward-sexp) (should (= 2 (line-number-at-pos))))) +(ert-deftest ruby-toggle-string-quotes-quotes-correctly () + (let ((pairs + '(("puts '\"foo\"\\''" . "puts \"\\\"foo\\\"'\"") + ("puts \"'foo'\\\"\"" . "puts '\\'foo\\'\"'")))) + (dolist (pair pairs) + (ruby-with-temp-buffer (car pair) + (beginning-of-line) + (search-forward "foo") + (ruby-toggle-string-quotes) + (should (string= (buffer-string) (cdr pair))))))) + (ert-deftest ruby--insert-coding-comment-ruby-style () (with-temp-buffer (let ((ruby-encoding-magic-comment-style 'ruby)) diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el new file mode 100644 index 00000000000..e05247a60ed --- /dev/null +++ b/test/lisp/progmodes/sql-tests.el @@ -0,0 +1,47 @@ +;;; sql-tests.el --- Tests for sql.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'cl-lib) +(require 'ert) +(require 'sql) + +(ert-deftest sql-tests-postgres-list-databases () + "Test that output from `psql -ltX' is parsed correctly." + (cl-letf + (((symbol-function 'executable-find) + (lambda (_command) t)) + ((symbol-function 'process-lines) + (lambda (_program &rest _args) + '(" db-name-1 | foo-user | UTF8 | en_US.UTF-8 | en_US.UTF-8 | " + " db_name_2 | foo-user | UTF8 | en_US.UTF-8 | en_US.UTF-8 | " + "")))) + (should (equal (sql-postgres-list-databases) + '("db-name-1" "db_name_2"))))) + +(provide 'sql-tests) +;;; sql-tests.el ends here diff --git a/test/automated/subword-tests.el b/test/lisp/progmodes/subword-tests.el index 5a562765bb1..5a562765bb1 100644 --- a/test/automated/subword-tests.el +++ b/test/lisp/progmodes/subword-tests.el diff --git a/test/automated/xref-tests.el b/test/lisp/progmodes/xref-tests.el index 079b196aa8b..2b745816c62 100644 --- a/test/automated/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -28,7 +28,7 @@ (defvar xref-tests-data-dir (expand-file-name "data/xref/" - (file-name-directory (or load-file-name (buffer-file-name))))) + (getenv "EMACS_TEST_DIRECTORY"))) (ert-deftest xref-collect-matches-finds-none-for-some-regexp () (should (null (xref-collect-matches "zzz" "*" xref-tests-data-dir nil)))) diff --git a/test/automated/cl-seq-tests.el b/test/lisp/ps-print-tests.el index d2eb412eee3..9ebd31b7460 100644 --- a/test/automated/cl-seq-tests.el +++ b/test/lisp/ps-print-tests.el @@ -1,8 +1,8 @@ -;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*- +;;; ps-print-tests.el --- Test suite for ps-print.el -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2016 Free Software Foundation, Inc. -;; Author: Nicolas Richard <youngfrog@members.fsf.org> +;; Author: Phillip Lord <phillip.lord@russet.org.uk> ;; This file is part of GNU Emacs. @@ -22,21 +22,15 @@ ;;; Commentary: ;;; Code: - +(require 'ps-print) (require 'ert) -(require 'cl-seq) - -(ert-deftest cl-union-test-00 () - (let ((str1 "foo") - (str2 (make-string 3 ?o))) - ;; Emacs may make two string literals eql when reading. - (aset str2 0 ?f) - (should (not (eql str1 str2))) - (should (equal str1 str2)) - (should (equal (cl-union (list str1) (list str2)) - (list str2))) - (should (equal (cl-union (list str1) (list str2) :test 'eql) - (list str1 str2))))) - -(provide 'cl-seq-tests) -;;; cl-seq-tests.el ends here + +;;; Autoload tests +(ert-deftest ps-mule-autoload () + "Tests to see whether ps-mule has been autoloaded" + (should + (fboundp 'ps-mule-initialize)) + (should + (autoloadp + (symbol-function + 'ps-mule-initialize)))) diff --git a/test/automated/occur-tests.el b/test/lisp/replace-tests.el index da45d5f6502..2b71348f350 100644 --- a/test/automated/occur-tests.el +++ b/test/lisp/replace-tests.el @@ -1,9 +1,9 @@ -;;; occur-tests.el --- Test suite for occur. +;;; replace-tests.el --- tests for replace.el. ;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Author: Nicolas Richard <youngfrog@members.fsf.org> ;; Author: Juri Linkov <juri@jurta.org> -;; Keywords: matching, internal ;; This file is part of GNU Emacs. @@ -24,7 +24,18 @@ (require 'ert) -(defconst occur-tests +(ert-deftest query-replace--split-string-tests () + (let ((sep (propertize "\0" 'separator t))) + (dolist (before '("" "b")) + (dolist (after '("" "a")) + (should (equal + (query-replace--split-string (concat before sep after)) + (cons before after))) + (should (equal + (query-replace--split-string (concat before "\0" after)) + (concat before "\0" after))))))) + +(defconst replace-occur-tests '( ;; * Test one-line matches (at bob, eob, bol, eol). ("x" 0 "\ @@ -317,7 +328,7 @@ h Each element has the format: \(REGEXP NLINES INPUT-BUFFER-STRING OUTPUT-BUFFER-STRING).") -(defun occur-test-case (test) +(defun replace-occur-test-case (test) (let ((regexp (nth 0 test)) (nlines (nth 1 test)) (input-buffer-string (nth 2 test)) @@ -333,20 +344,18 @@ Each element has the format: (and (buffer-name temp-buffer) (kill-buffer temp-buffer))))) -(defun occur-test-create (n) - "Create a test for element N of the `occur-tests' constant." +(defun replace-occur-test-create (n) + "Create a test for element N of the `replace-occur-tests' constant." (let ((testname (intern (format "occur-test-%.2d" n))) - (testdoc (format "Test element %d of `occur-tests'." n))) + (testdoc (format "Test element %d of `replace-occur-tests'." n))) (eval `(ert-deftest ,testname () ,testdoc - (let (occur-hook) - (should (equal (occur-test-case (nth ,n occur-tests)) - (nth 3 (nth ,n occur-tests))))))))) - -(dotimes (i (length occur-tests)) - (occur-test-create i)) + (let (replace-occur-hook) + (should (equal (replace-occur-test-case (nth ,n replace-occur-tests)) + (nth 3 (nth ,n replace-occur-tests))))))))) -(provide 'occur-tests) +(dotimes (i (length replace-occur-tests)) + (replace-occur-test-create i)) -;;; occur-tests.el ends here +;;; replace-tests.el ends here diff --git a/test/lisp/rot13-tests.el b/test/lisp/rot13-tests.el new file mode 100644 index 00000000000..a31dc50f8fc --- /dev/null +++ b/test/lisp/rot13-tests.el @@ -0,0 +1,54 @@ +;;; rot13-tests.el --- Tests for rot13.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'rot13) + +(ert-deftest rot13-tests-rot13 () + (should (equal (rot13 "Super-secret text") "Fhcre-frperg grkg")) + (with-temp-buffer + (insert "Super-secret text") + (rot13 (current-buffer) (point-min) (point-max)) + (should (equal (buffer-string) "Fhcre-frperg grkg")) + (rot13 (current-buffer) (point-min) (+ (point-min) 5)) + (should (equal (buffer-string) "Super-frperg grkg")))) + +(ert-deftest rot13-tests-rot13-string () + (should (equal (rot13-string "") "")) + (should (equal (rot13-string (rot13-string "foo")) "foo")) + (should (equal (rot13-string "Super-secret text") + "Fhcre-frperg grkg"))) + +(ert-deftest rot13-tests-rot13-region () + (with-temp-buffer + (insert "Super-secret text") + (rot13-region (+ (point-min) 6) (+ (point-min) 12)) + (should (equal (buffer-string) "Super-frperg text")))) + +(provide 'rot13-tests) +;;; rot13-tests.el ends here diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el new file mode 100644 index 00000000000..be8f7d5c139 --- /dev/null +++ b/test/lisp/shell-tests.el @@ -0,0 +1,33 @@ +;;; shell-tests.el -*- lexical-binding:t -*- + +;; Copyright (C) 2010-2016 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for comint and related modes. + +;;; Code: + +(require 'shell) +(require 'ert) + +(ert-deftest shell-tests-unquote-1 () + "Test problem found by Filipp Gunbin in emacs-devel." + (should (equal (car (shell--unquote&requote-argument "te'st" 2)) "test"))) + +;;; shell-tests.el ends here diff --git a/test/automated/simple-test.el b/test/lisp/simple-tests.el index c41d01075ed..d022240ae5c 100644 --- a/test/automated/simple-test.el +++ b/test/lisp/simple-tests.el @@ -204,7 +204,7 @@ ;;; `delete-trailing-whitespace' -(ert-deftest simple-delete-trailing-whitespace () +(ert-deftest simple-delete-trailing-whitespace--bug-21766 () "Test bug#21766: delete-whitespace sometimes deletes non-whitespace." (defvar python-indent-guess-indent-offset) ; to avoid a warning (let ((python (featurep 'python)) @@ -219,11 +219,25 @@ "\n" "\n")) (delete-trailing-whitespace) - (should (equal (count-lines (point-min) (point-max)) 3))) + (should (string-equal (buffer-string) + (concat "query = \"\"\"WITH filtered AS\n" + "WHERE\n" + "\"\"\".format(fv_)\n")))) ;; Let's clean up if running interactive (unless (or noninteractive python) (unload-feature 'python))))) +(ert-deftest simple-delete-trailing-whitespace--formfeeds () + "Test formfeeds are not deleted but whitespace past them is." + (with-temp-buffer + (with-syntax-table (make-syntax-table) + (modify-syntax-entry ?\f " ") ; Make sure \f is whitespace + (insert " \f \n \f \f \n\nlast\n") + (delete-trailing-whitespace) + (should (string-equal (buffer-string) " \f\n \f \f\n\nlast\n")) + (should (equal ?\s (char-syntax ?\f))) + (should (equal ?\s (char-syntax ?\n)))))) + ;;; auto-boundary tests (ert-deftest undo-auto-boundary-timer () diff --git a/test/automated/sort-tests.el b/test/lisp/sort-tests.el index f3a182cdc14..f3a182cdc14 100644 --- a/test/automated/sort-tests.el +++ b/test/lisp/sort-tests.el diff --git a/test/automated/subr-tests.el b/test/lisp/subr-tests.el index ce212903c9d..82a70ca072b 100644 --- a/test/automated/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -224,5 +224,52 @@ (error-message-string (should-error (version-to-list "beta22_8alpha3"))) "Invalid version syntax: `beta22_8alpha3' (must start with a number)")))) +(defun subr-test--backtrace-frames-with-backtrace-frame (base) + "Reference implementation of `backtrace-frames'." + (let ((idx 0) + (frame nil) + (frames nil)) + (while (setq frame (backtrace-frame idx base)) + (push frame frames) + (setq idx (1+ idx))) + (nreverse frames))) + +(defun subr-test--frames-2 (base) + (let ((_dummy nil)) + (progn ;; Add a few frames to top of stack + (unwind-protect + (cons (mapcar (pcase-lambda (`(,evald ,func ,args ,_)) + `(,evald ,func ,@args)) + (backtrace-frames base)) + (subr-test--backtrace-frames-with-backtrace-frame base)))))) + +(defun subr-test--frames-1 (base) + (subr-test--frames-2 base)) + +(ert-deftest subr-test-backtrace-simple-tests () + "Test backtrace-related functions (simple tests). +This exercises `backtrace-frame', and indirectly `mapbacktrace'." + ;; `mapbacktrace' returns nil + (should (equal (mapbacktrace #'ignore) nil)) + ;; Unbound BASE is silently ignored + (let ((unbound (make-symbol "ub"))) + (should (equal (backtrace-frame 0 unbound) nil)) + (should (equal (mapbacktrace #'error unbound) nil))) + ;; First frame is backtrace-related function + (should (equal (backtrace-frame 0) '(t backtrace-frame 0))) + (should (equal (catch 'ret + (mapbacktrace (lambda (&rest args) (throw 'ret args)))) + '(t mapbacktrace ((lambda (&rest args) (throw 'ret args))) nil))) + ;; Past-end NFRAMES is silently ignored + (should (equal (backtrace-frame most-positive-fixnum) nil))) + +(ert-deftest subr-test-backtrace-integration-test () + "Test backtrace-related functions (integration test). +This exercises `backtrace-frame', `backtrace-frames', and +indirectly `mapbacktrace'." + ;; Compare two implementations of backtrace-frames + (let ((frame-lists (subr-test--frames-1 'subr-test--frames-2))) + (should (equal (car frame-lists) (cdr frame-lists))))) + (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el new file mode 100644 index 00000000000..f92ac111142 --- /dev/null +++ b/test/lisp/textmodes/css-mode-tests.el @@ -0,0 +1,222 @@ +;;; css-mode-tests.el --- Test suite for CSS mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl <simenheg@gmail.com> +;; Keywords: internal + +;; This file is part of GNU Emacs. + +;; This program 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, +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'css-mode) +(require 'ert) +(require 'seq) + +(ert-deftest css-test-property-values () + ;; The `float' property has a flat value list. + (should + (equal (seq-sort #'string-lessp (css--property-values "float")) + '("left" "none" "right"))) + + ;; The `list-style' property refers to several other properties. + (should + (equal (seq-sort #'string-lessp (css--property-values "list-style")) + (seq-sort + #'string-lessp + (seq-uniq + (append (css--property-values "list-style-type") + (css--property-values "list-style-position") + (css--property-values "list-style-image")))))) + + ;; The `position' property is tricky because it's also the name of a + ;; value class. + (should + (equal (seq-sort #'string-lessp (css--property-values "position")) + '("absolute" "fixed" "relative" "static"))) + + ;; The `background-position' property should refer to the `position' + ;; value class, not the property of the same name. + (should + (equal (css--property-values "background-position") + (css--value-class-lookup 'position))) + + ;; Check that the `color' property doesn't cause infinite recursion + ;; because it refers to the value class of the same name. + (should (= (length (css--property-values "color")) 147))) + +(ert-deftest css-test-property-value-cache () + "Test that `css--property-value-cache' is in use." + (should-not (gethash "word-wrap" css--property-value-cache)) + (let ((word-wrap-values (css--property-values "word-wrap"))) + (should (equal (gethash "word-wrap" css--property-value-cache) + word-wrap-values)))) + +(ert-deftest css-test-property-values-no-duplicates () + "Test that `css--property-values' returns no duplicates." + ;; The `flex' property is prone to duplicate values; if they aren't + ;; removed, it'll contain at least two instances of `auto'. + (should + (equal (seq-sort #'string-lessp (css--property-values "flex")) + '("auto" "calc()" "content" "none")))) + +(ert-deftest css-test-value-class-lookup () + (should + (equal (seq-sort #'string-lessp (css--value-class-lookup 'position)) + '("bottom" "calc()" "center" "left" "right" "top")))) + +;;; Completion + +(defun css-mode-tests--completions () + (let ((data (css-completion-at-point))) + (all-completions (buffer-substring (nth 0 data) (nth 1 data)) + (nth 2 data)))) + +(ert-deftest css-test-complete-bang-rule () + (with-temp-buffer + (css-mode) + (insert "body { left: 0 !") + (let ((completions (css-mode-tests--completions))) + (should (member "important" completions)) + ;; Don't include SCSS bang-rules + (should-not (member "default" completions))))) + +(ert-deftest scss-test-complete-bang-rule () + (with-temp-buffer + (scss-mode) + (insert "body { left: 0 !") + (let ((completions (css-mode-tests--completions))) + (should (member "important" completions)) + (should (member "default" completions))))) + +(ert-deftest css-test-complete-property-value () + (with-temp-buffer + (css-mode) + (insert "body { position: ") + (let ((completions (css-mode-tests--completions))) + (should + (equal (seq-sort #'string-lessp completions) + '("absolute" "fixed" "inherit" "initial" "relative" + "static" "unset")))))) + +(ert-deftest css-test-complete-pseudo-class () + (with-temp-buffer + (css-mode) + (insert "body:a") + (let ((completions (css-mode-tests--completions))) + (should (member "active" completions)) + (should-not (member "disabled" completions)) + ;; Don't include pseudo-elements + (should-not (member "after" completions))))) + +(ert-deftest css-test-complete-pseudo-element () + (with-temp-buffer + (css-mode) + (insert "body::a") + (let ((completions (css-mode-tests--completions))) + (should (member "after" completions)) + (should-not (member "disabled" completions)) + ;; Don't include pseudo-classes + (should-not (member "active" completions))))) + +(ert-deftest css-test-complete-at-rule () + (with-temp-buffer + (css-mode) + (insert "@m") + (let ((completions (css-mode-tests--completions))) + (should (member "media" completions)) + (should-not (member "keyframes" completions)) + ;; Don't include SCSS at-rules + (should-not (member "mixin" completions))))) + +(ert-deftest scss-test-complete-at-rule () + (with-temp-buffer + (scss-mode) + (insert "@m") + (let ((completions (css-mode-tests--completions))) + (should (member "media" completions)) + (should-not (member "keyframes" completions)) + (should (member "mixin" completions))))) + +(ert-deftest css-test-complete-property () + (with-temp-buffer + (css-mode) + (insert "body { f") + (let ((completions (css-mode-tests--completions))) + (should (member "filter" completions)) + (should-not (member "position" completions))))) + +(ert-deftest css-test-foreign-completions () + (let ((other-buffer-1 (generate-new-buffer "1")) + (other-buffer-2 (generate-new-buffer "2"))) + (with-current-buffer other-buffer-1 + (setq-local css-class-list-function (lambda () '("foo" "bar")))) + (with-current-buffer other-buffer-2 + (setq-local css-class-list-function (lambda () '("bar" "baz")))) + (let ((completions + (css--foreign-completions 'css-class-list-function))) + ;; Completions from `other-buffer-1' and `other-buffer-2' should + ;; be merged. + (should (equal (seq-sort #'string-lessp completions) + '("bar" "baz" "foo")))) + (kill-buffer other-buffer-1) + (kill-buffer other-buffer-2))) + +(ert-deftest css-test-complete-selector-tag () + (with-temp-buffer + (css-mode) + (insert "b") + (let ((completions (css-mode-tests--completions))) + (should (member "body" completions)) + (should-not (member "article" completions))))) + +(ert-deftest css-test-complete-selector-class () + (with-temp-buffer + (setq-local css-class-list-function (lambda () '("foo" "bar"))) + (with-temp-buffer + (css-mode) + (insert ".f") + (let ((completions (css-mode-tests--completions))) + (should (equal completions '("foo"))))))) + +(ert-deftest css-test-complete-selector-id () + (with-temp-buffer + (setq-local css-id-list-function (lambda () '("foo" "bar"))) + (with-temp-buffer + (css-mode) + (insert "#b") + (let ((completions (css-mode-tests--completions))) + (should (equal completions '("bar"))))))) + +(ert-deftest css-test-complete-nested-selector () + (with-temp-buffer + (css-mode) + (insert "body {") + (let ((completions (css-mode-tests--completions))) + (should-not (member "body" completions))))) + +(ert-deftest scss-test-complete-nested-selector () + (with-temp-buffer + (scss-mode) + (insert "body { b") + (let ((completions (css-mode-tests--completions))) + (should (member "body" completions)) + (should-not (member "article" completions))))) + +(provide 'css-mode-tests) +;;; css-mode-tests.el ends here diff --git a/test/automated/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el index 0f1186d8a82..12ec7f5a394 100644 --- a/test/automated/reftex-tests.el +++ b/test/lisp/textmodes/reftex-tests.el @@ -204,5 +204,20 @@ (should (string= (reftex-format-citation entry "%l:%A:%y:%t %j %P %a") "Foo13:Jane Roe:2013:Some Article Some Journal 1 Jane Roe, John Doe \\& Jane Taxpayer")))) + +;;; Autoload tests + +;; Test to check whether reftex autoloading mechanisms are working +;; correctly. +(ert-deftest reftex-autoload-auc () + "Tests to see whether reftex-auc has been autoloaded" + (should + (fboundp 'reftex-arg-label)) + (should + (autoloadp + (symbol-function + 'reftex-arg-label)))) + + (provide 'reftex-tests) ;;; reftex-tests.el ends here. diff --git a/test/automated/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el index 4184e2c3802..4184e2c3802 100644 --- a/test/automated/sgml-mode-tests.el +++ b/test/lisp/textmodes/sgml-mode-tests.el diff --git a/test/automated/tildify-tests.el b/test/lisp/textmodes/tildify-tests.el index 8b50cf72868..8b50cf72868 100644 --- a/test/automated/tildify-tests.el +++ b/test/lisp/textmodes/tildify-tests.el diff --git a/test/automated/thingatpt.el b/test/lisp/thingatpt-tests.el index d3ecbf8c642..6d73d9001ae 100644 --- a/test/automated/thingatpt.el +++ b/test/lisp/thingatpt-tests.el @@ -84,4 +84,40 @@ position to retrieve THING.") (goto-char (nth 1 test)) (should (equal (thing-at-point (nth 2 test)) (nth 3 test)))))) +;; These tests reflect the actual behavior of +;; `thing-at-point-bounds-of-list-at-point'. +(ert-deftest thing-at-point-bug24627 () + "Test for http://debbugs.gnu.org/24627 ." + (let ((string-result '(("(a \"b\" c)" . (a "b" c)) + (";(a \"b\" c)") + ("(a \"b\" c\n)" . (a "b" c)) + ("\"(a b c)\"") + ("(a ;(b c d)\ne)" . (a e)) + ("(foo\n(a ;(b c d)\ne) bar)" . (a e)) + ("(foo\na ;(b c d)\ne bar)" . (foo a e bar)) + ("(foo\n(a \"(b c d)\"\ne) bar)" . (a "(b c d)" e)) + ("(b\n(a ;(foo c d)\ne) bar)" . (a e)) + ("(princ \"(a b c)\")" . (princ "(a b c)")) + ("(defun foo ()\n \"Test function.\"\n ;;(a b)\n nil)" . (defun foo nil "Test function." nil)))) + (file + (expand-file-name "lisp/thingatpt.el" source-directory)) + buf) + ;; Test for `thing-at-point'. + (when (file-exists-p file) + (unwind-protect + (progn + (setq buf (find-file file)) + (goto-char (point-max)) + (forward-line -1) + (should-not (thing-at-point 'list))) + (kill-buffer buf))) + ;; Tests for `list-at-point'. + (dolist (str-res string-result) + (with-temp-buffer + (emacs-lisp-mode) + (insert (car str-res)) + (re-search-backward "\\((a\\|^a\\)") + (should (equal (list-at-point) + (cdr str-res))))))) + ;;; thingatpt.el ends here diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el new file mode 100644 index 00000000000..bc30f3518e4 --- /dev/null +++ b/test/lisp/url/url-auth-tests.el @@ -0,0 +1,255 @@ +;;; url-auth-tests.el --- Test suite for url-auth. + +;; Copyright (C) 2015-2016 Free Software Foundation, Inc. + +;; Author: Jarno Malmari <jarno@malmari.fi> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Test HTTP authentication methods. + +;;; Code: + +(require 'ert) +(require 'url-auth) + +(defvar url-auth-test-challenges nil + "List of challenges for testing. +Each challenge is a plist. Values are as presented by the +server's WWW-Authenticate header field.") + +;; Set explicitly for easier modification for re-runs. +(setq url-auth-test-challenges + (list + (list :qop "auth" + :nonce "uBr3+qkQBybTr/dKWkmpUqVO7SaEwWYzyTKO7g==$" + :uri "/random/path" + :method "GET" + :realm "Some test realm" + :cnonce "YWU4NDcxYWMxMDAxMjlkMjAwMDE4MjI5MDAwMGY4NGQ=" + :nc "00000001" + :username "jytky" + :password "xi5Ac2HEfKt1lKKO05DCSqsK0u7hqqtsT" + :expected-ha1 "af521db3a83abd91262fead04fa31892" + :expected-ha2 "e490a6a147c79404b365d1f6059ddda5" + :expected-response "ecb6396e93b9e09e31f19264cfd8f854") + (list :nonce "a1be8a3065e00c5bf190ad499299aea5" + :opaque "d7c2a27230fc8c74bb6e06be8c9cd189" + :realm "The Test Realm" + :username "user" + :password "passwd" + :uri "/digest-auth/auth/user/passwd" + :method "GET" + :expected-ha1 "19c41161a8720edaeb7922ef8531137d" + :expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863" + :expected-response "46c47a6d8e1fa95a3efcf49724af3fe7") + (list :nonce "servernonce" + :username "user" + :password "passwd" + :realm "The Test Realm 1" + :uri "/digest-auth/auth/user/passwd" + :method "GET" + :expected-ha1 "00f848f943c9a05dd06c932a7334f120" + :expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863" + :expected-response "b8a48cdc9aa9e514509a5a5c53d4e8cf") + (list :nonce "servernonce" + :username "user" + :password "passwd" + :realm "The Test Realm 2" + :uri "/digest-auth/auth/user/passwd" + :method "GET" + :expected-ha1 "74d6abd3651d6b8260733d8a4c37ec1a" + :expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863" + :expected-response "0d84884d967e04440efc77e9e2b5b561"))) + +(ert-deftest url-auth-test-digest-create-key () + "Check user credentials in their hashed form." + (dolist (challenge url-auth-test-challenges) + (let ((key (url-digest-auth-create-key (plist-get challenge :username) + (plist-get challenge :password) + (plist-get challenge :realm) + (plist-get challenge :method) + (plist-get challenge :uri)))) + (should (= (length key) 2)) + (should (string= (nth 0 key) (plist-get challenge :expected-ha1))) + (should (string= (nth 1 key) (plist-get challenge :expected-ha2))) + ))) + +(ert-deftest url-auth-test-digest-auth-retrieve-cache () + "Check how the entry point retrieves cached authentication. +Essential is how realms and paths are matched." + + (let* ((url-digest-auth-storage + '(("example.org:80" + ("/path/auth1" "auth1user" "key") + ("/path" "pathuser" "key") + ("/" "rootuser" "key") + ("realm1" "realm1user" "key") + ("realm2" "realm2user" "key") + ("/path/auth2" "auth2user" "key")) + ("example.org:443" + ("realm" "secure_user" "key")) + ("rootless.org:80" ; no "/" entry for this on purpose + ("/path" "pathuser" "key") + ("realm" "realmuser" "key")))) + (attrs (list (cons "nonce" "servernonce"))) + auth) + + (dolist (row (list + ;; If :expected-user is `nil' it indicates + ;; authentication information shouldn't be found. + + ;; non-existent server + (list :url "http://other.com/path" + :realm nil :expected-user nil) + + ;; unmatched port + (list :url "http://example.org:444/path" + :realm nil :expected-user nil) + + ;; root, no realm + (list :url "http://example.org/" + :realm nil :expected-user "rootuser") + + ;; root, no realm, explicit port + (list :url "http://example.org:80/" + :realm nil :expected-user "rootuser") + + (list :url "http://example.org/unknown" + :realm nil :expected-user "rootuser") + + ;; realm specified, overrides any path + (list :url "http://example.org/" + :realm "realm1" :expected-user "realm1user") + + ;; realm specified, overrides any path + (list :url "http://example.org/" + :realm "realm2" :expected-user "realm2user") + + ;; authentication determined by path + (list :url "http://example.org/path/auth1/query" + :realm nil :expected-user "auth1user") + + ;; /path shadows /path/auth2, hence pathuser is expected + (list :url "http://example.org/path/auth2/query" + :realm nil :expected-user "pathuser") + + (list :url "https://example.org/path" + :realm nil :expected-user "secure_user") + + ;; not really secure user but using the same port + (list :url "http://example.org:443/path" + :realm nil :expected-user "secure_user") + + ;; preferring realm user over path, even though no + ;; realm specified (not sure why) + (list :url "http://rootless.org/" + :realm nil :expected-user "realmuser") + ;; second variant for the same case + (list :url "http://rootless.org/unknown/path" + :realm nil :expected-user "realmuser") + + ;; path match + (list :url "http://rootless.org/path/query?q=a" + :realm nil :expected-user "pathuser") + + ;; path match, realm match, prefer realm + (list :url "http://rootless.org/path/query?q=a" + :realm "realm" :expected-user "realmuser") + )) + (setq auth (url-digest-auth (plist-get row :url) + nil nil + (plist-get row :realm) attrs)) + (if (plist-get row :expected-user) + (progn (should auth) + (should (string-match ".*username=\"\\(.*?\\)\".*" auth)) + (should (string= (match-string 1 auth) + (plist-get row :expected-user)))) + (should-not auth))))) + +(ert-deftest url-auth-test-digest-auth () + "Check common authorization string contents. +Challenges with qop are not checked for response since a unique +cnonce is used for generating them which is not mocked by the +test and cannot be passed by arguments to `url-digest-auth'." + (dolist (challenge url-auth-test-challenges) + (let* ((attrs (append + (list (cons "nonce" (plist-get challenge :nonce))) + (if (plist-get challenge :qop) + (list (cons "qop" (plist-get challenge :qop)))))) + (url (concat "http://example.org" (plist-get challenge :uri))) + url-digest-auth-storage + auth) + ;; Add authentication info to cache so `url-digest-auth' can + ;; complete without prompting minibuffer input. + (setq url-digest-auth-storage + (list + (list "example.org:80" + (cons (or (plist-get challenge :realm) "/") + (cons (plist-get challenge :username) + (url-digest-auth-create-key + (plist-get challenge :username) + (plist-get challenge :password) + (plist-get challenge :realm) + (plist-get challenge :method) + (plist-get challenge :uri))))))) + (setq auth (url-digest-auth (url-generic-parse-url url) nil nil + (plist-get challenge :realm) attrs)) + (should auth) + (should (string-prefix-p "Digest " auth)) + (should (string-match ".*username=\"\\(.*?\\)\".*" auth)) + (should (string= (match-string 1 auth) + (plist-get challenge :username))) + (should (string-match ".*realm=\"\\(.*?\\)\".*" auth)) + (should (string= (match-string 1 auth) + (plist-get challenge :realm))) + + (if (plist-member challenge :qop) + (progn + ;; We don't know these, just check that they exists. + (should (string-match-p ".*response=\".*?\".*" auth)) + ;; url-digest-auth doesn't return these AFAICS. +;;; (should (string-match-p ".*nc=\".*?\".*" auth)) +;;; (should (string-match-p ".*cnonce=\".*?\".*" auth)) + ) + (should (string-match ".*response=\"\\(.*?\\)\".*" auth)) + (should (string= (match-string 1 auth) + (plist-get challenge :expected-response)))) + ))) + +(ert-deftest url-auth-test-digest-auth-opaque () + "Check that `opaque' value is added to result when presented by +the server." + (let* ((url-digest-auth-storage + '(("example.org:80" ("/" "user" "key")))) + (attrs (list (cons "nonce" "anynonce"))) + auth) + ;; Get authentication info from cache without `opaque'. + (setq auth (url-digest-auth "http://example.org/path" nil nil nil attrs)) + (should auth) + (should-not (string-match-p "opaque=" auth)) + + ;; Add `opaque' to attributes. + (push (cons "opaque" "opaque-value") attrs) + (setq auth (url-digest-auth "http://example.org/path" nil nil nil attrs)) + (should auth) + (should (string-match ".*opaque=\"\\(.*?\\)\".*" auth)) + (should (string= (match-string 1 auth) "opaque-value")))) + +(provide 'url-auth-tests) +;;; url-auth-tests.el ends here diff --git a/test/automated/url-expand-tests.el b/test/lisp/url/url-expand-tests.el index 6d1d54d4ffc..6d1d54d4ffc 100644 --- a/test/automated/url-expand-tests.el +++ b/test/lisp/url/url-expand-tests.el diff --git a/test/automated/url-future-tests.el b/test/lisp/url/url-future-tests.el index 87298cc1b96..87298cc1b96 100644 --- a/test/automated/url-future-tests.el +++ b/test/lisp/url/url-future-tests.el diff --git a/test/automated/url-parse-tests.el b/test/lisp/url/url-parse-tests.el index 77c5320e351..77c5320e351 100644 --- a/test/automated/url-parse-tests.el +++ b/test/lisp/url/url-parse-tests.el diff --git a/test/automated/url-util-tests.el b/test/lisp/url/url-util-tests.el index 2f1de5103d6..2f1de5103d6 100644 --- a/test/automated/url-util-tests.el +++ b/test/lisp/url/url-util-tests.el diff --git a/test/automated/add-log-tests.el b/test/lisp/vc/add-log-tests.el index 71be5a9eadc..71be5a9eadc 100644 --- a/test/automated/add-log-tests.el +++ b/test/lisp/vc/add-log-tests.el diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el new file mode 100644 index 00000000000..427423a7407 --- /dev/null +++ b/test/lisp/vc/ediff-ptch-tests.el @@ -0,0 +1,42 @@ +;;; ediff-ptch-tests.el --- Tests for ediff-ptch.el + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Tino Calancha <tino.calancha@gmail.com> + +;; This program 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, 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 `http://www.gnu.org/licenses/'. + +;;; Code: + +(require 'ert) +(require 'ediff-ptch) + +(ert-deftest ibuffer-test-bug25010 () + "Test for http://debbugs.gnu.org/25010 ." + (with-temp-buffer + (insert "diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el +index 6a07f80..6e8e947 100644 +--- a/lisp/vc/ediff-ptch.el ++++ b/lisp/vc/ediff-ptch.el +@@ -120,11 +120,12 @@ ediff-patch-default-directory +") + (goto-char (point-min)) + (let ((filename + (progn + (re-search-forward ediff-context-diff-label-regexp nil t) + (match-string 1)))) + (should-not (string-suffix-p "@@" filename))))) + +(provide 'ediff-ptch-tests) +;;; ediff-ptch-tests.el ends here diff --git a/test/automated/vc-bzr.el b/test/lisp/vc/vc-bzr-tests.el index 82721eeee4e..f27e6588cf2 100644 --- a/test/automated/vc-bzr.el +++ b/test/lisp/vc/vc-bzr-tests.el @@ -101,12 +101,8 @@ (while (vc-dir-busy) (sit-for 0.1)) (vc-dir-mark-all-files t) - (let ((f (symbol-function 'y-or-n-p))) - (unwind-protect - (progn - (fset 'y-or-n-p (lambda (prompt) t)) - (vc-next-action nil)) - (fset 'y-or-n-p f))) + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) t))) + (vc-next-action nil)) (should (get-buffer "*vc-log*"))) (delete-directory homedir t)))) diff --git a/test/automated/vc-hg.el b/test/lisp/vc/vc-hg.el index ba966598c4d..ba966598c4d 100644 --- a/test/automated/vc-hg.el +++ b/test/lisp/vc/vc-hg.el diff --git a/test/automated/vc-tests.el b/test/lisp/vc/vc-tests.el index 5042196f425..b54a45dd323 100644 --- a/test/automated/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -109,6 +109,8 @@ (require 'ert) (require 'vc) +(declare-function w32-application-type "w32proc") + ;; The working horses. (defvar vc-test--cleanup-hook nil @@ -117,7 +119,7 @@ Don't set it globally, the functions shall be let-bound.") (defun vc-test--revision-granularity-function (backend) "Run the `vc-revision-granularity' backend function." - (funcall (intern (downcase (format "vc-%s-revision-granularity" backend))))) + (vc-call-backend backend 'revision-granularity)) (defun vc-test--create-repo-function (backend) "Run the `vc-create-repo' backend function. @@ -201,19 +203,28 @@ For backends which dont support it, it is emulated." ;; Save exit. (ignore-errors (run-hooks 'vc-test--cleanup-hook))))) -;; Why isn't there `vc-unregister'? +;; FIXME: Why isn't there `vc-unregister'? (defun vc-test--unregister-function (backend file) "Run the `vc-unregister' backend function. -For backends which dont support it, `vc-not-supported' is signalled." - - (let ((symbol (intern (downcase (format "vc-%s-unregister" backend))))) - (if (functionp symbol) - (funcall symbol file) - ;; CVS, SVN, SCCS, SRC and Mtn are not supported. - (signal 'vc-not-supported (list 'unregister backend))))) +For backends which don't support it, `vc-not-supported' is signaled." + ;; CVS, SVN, SCCS, SRC and Mtn are not supported, and will signal + ;; `vc-not-supported'. + (prog1 + (vc-call-backend backend 'unregister file) + (vc-file-clearprops file))) + +(defmacro vc-test--run-maybe-unsupported-function (func &rest args) + "Run FUNC with ARGS as arguments. +Catch the `vc-not-supported' error." + `(let (err) + (condition-case err + (funcall ,func ,@args) + (vc-not-supported 'vc-not-supported) + (t (signal (car err) (cdr err)))))) (defun vc-test--register (backend) - "Register and unregister a file." + "Register and unregister a file. +This checks also `vc-backend' and `vc-responsible-backend'." (let ((vc-handled-backends `(,backend)) (default-directory @@ -232,32 +243,56 @@ For backends which dont support it, `vc-not-supported' is signalled." ;; Create empty repository. (make-directory default-directory) (vc-test--create-repo-function backend) + ;; For file oriented backends CVS, RCS and SVN the backend is + ;; returned, and the directory is registered already. + (should (if (vc-backend default-directory) + (vc-registered default-directory) + (not (vc-registered default-directory)))) + (should (eq (vc-responsible-backend default-directory) backend)) (let ((tmp-name1 (expand-file-name "foo" default-directory)) (tmp-name2 "bla")) ;; Register files. Check for it. (write-region "foo" nil tmp-name1 nil 'nomessage) (should (file-exists-p tmp-name1)) + (should-not (vc-backend tmp-name1)) + (should (eq (vc-responsible-backend tmp-name1) backend)) (should-not (vc-registered tmp-name1)) + (write-region "bla" nil tmp-name2 nil 'nomessage) (should (file-exists-p tmp-name2)) + (should-not (vc-backend tmp-name2)) + (should (eq (vc-responsible-backend tmp-name2) backend)) (should-not (vc-registered tmp-name2)) + (vc-register (list backend (list tmp-name1 tmp-name2))) (should (file-exists-p tmp-name1)) + (should (eq (vc-backend tmp-name1) backend)) + (should (eq (vc-responsible-backend tmp-name1) backend)) (should (vc-registered tmp-name1)) + (should (file-exists-p tmp-name2)) + (should (eq (vc-backend tmp-name2) backend)) + (should (eq (vc-responsible-backend tmp-name2) backend)) (should (vc-registered tmp-name2)) + ;; `vc-backend' accepts also a list of files, + ;; `vc-responsible-backend' doesn't. + (should (vc-backend (list tmp-name1 tmp-name2))) + ;; Unregister the files. - (condition-case err - (progn - (vc-test--unregister-function backend tmp-name1) - (should-not (vc-registered tmp-name1)) - (vc-test--unregister-function backend tmp-name2) - (should-not (vc-registered tmp-name2))) - ;; CVS, SVN, SCCS, SRC and Mtn are not supported. - (vc-not-supported t)) - ;; The files shall still exist. + (unless (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name1) + 'vc-not-supported) + (should-not (vc-backend tmp-name1)) + (should-not (vc-registered tmp-name1))) + (unless (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name2) + 'vc-not-supported) + (should-not (vc-backend tmp-name2)) + (should-not (vc-registered tmp-name2))) + + ;; The files shall still exist. (should (file-exists-p tmp-name1)) (should (file-exists-p tmp-name2)))) @@ -281,70 +316,42 @@ For backends which dont support it, `vc-not-supported' is signalled." 'vc-test--cleanup-hook `(lambda () (delete-directory ,default-directory 'recursive))) - ;; Create empty repository. Check repository state. + ;; Create empty repository. (make-directory default-directory) (vc-test--create-repo-function backend) - ;; nil: Hg Mtn RCS - ;; added: Git - ;; unregistered: CVS SCCS SRC - ;; up-to-date: Bzr SVN - (message "vc-state1 %s" (vc-state default-directory)) - ;;(should (eq (vc-state default-directory) - ;;(vc-state default-directory backend))) - (should (memq (vc-state default-directory) - '(nil added unregistered up-to-date))) - (let ((tmp-name (expand-file-name "foo" default-directory))) - ;; Check state of an empty file. + ;; Check state of a nonexistent file. - ;; nil: Hg Mtn SRC SVN - ;; added: Git - ;; unregistered: RCS SCCS - ;; up-to-date: Bzr CVS (message "vc-state2 %s" (vc-state tmp-name)) - ;;(should (eq (vc-state tmp-name) (vc-state tmp-name backend))) - (should (memq (vc-state tmp-name) - '(nil added unregistered up-to-date))) + (should (null (vc-state tmp-name))) ;; Write a new file. Check state. (write-region "foo" nil tmp-name nil 'nomessage) - ;; nil: Mtn - ;; added: Git - ;; unregistered: Hg RCS SCCS SRC SVN - ;; up-to-date: Bzr CVS (message "vc-state3 %s" (vc-state tmp-name)) - ;;(should (eq (vc-state tmp-name) (vc-state tmp-name backend))) - (should (memq (vc-state tmp-name) - '(nil added unregistered up-to-date))) + (should (null (vc-state tmp-name))) ;; Register a file. Check state. (vc-register (list backend (list (file-name-nondirectory tmp-name)))) - ;; added: Git Mtn - ;; unregistered: Hg RCS SCCS SRC SVN - ;; up-to-date: Bzr CVS + ;; FIXME: nil is definitely wrong. + ;; nil: SRC + ;; added: Bzr CVS Git Hg Mtn SVN + ;; up-to-date: RCS SCCS (message "vc-state4 %s" (vc-state tmp-name)) - ;;(should (eq (vc-state tmp-name) (vc-state tmp-name backend))) - (should (memq (vc-state tmp-name) - '(nil added unregistered up-to-date))) + (should (memq (vc-state tmp-name) '(nil added up-to-date))) ;; Unregister the file. Check state. - (condition-case nil - (progn - (vc-test--unregister-function backend tmp-name) - - ;; added: Git - ;; unregistered: Hg RCS - ;; unsupported: CVS Mtn SCCS SRC SVN - ;; up-to-date: Bzr - (message "vc-state5 %s" (vc-state tmp-name)) - ;;(should (eq (vc-state tmp-name) (vc-state tmp-name backend))) - (should (memq (vc-state tmp-name) - '(nil added unregistered up-to-date)))) - (vc-not-supported (message "vc-state5 unsupported"))))) + (if (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name) + 'vc-not-supported) + (message "vc-state5 unsupported") + ;; nil: Bzr Git Hg RCS + ;; unsupported: CVS Mtn SCCS SRC SVN + (message "vc-state5 %s" (vc-state tmp-name)) + (should (null (vc-state tmp-name)))))) ;; Save exit. (ignore-errors (run-hooks 'vc-test--cleanup-hook))))) @@ -371,60 +378,51 @@ For backends which dont support it, `vc-not-supported' is signalled." (make-directory default-directory) (vc-test--create-repo-function backend) - ;; nil: CVS Git Mtn RCS SCCS - ;; "0": Bzr Hg SRC SVN + ;; FIXME: Is the value for SVN correct? + ;; nil: Bzr CVS Git Hg Mtn RCS SCCS SRC + ;; "0": SVN (message "vc-working-revision1 %s" (vc-working-revision default-directory)) - ;;(should (eq (vc-working-revision default-directory) - ;;(vc-working-revision default-directory backend))) - (should (member (vc-working-revision default-directory) '(nil "0"))) + (should (member (vc-working-revision default-directory) '(nil "0"))) (let ((tmp-name (expand-file-name "foo" default-directory))) ;; Check initial working revision, should be nil until ;; it's registered. - ;; nil: CVS Git Mtn RCS SCCS SVN - ;; "0": Bzr Hg SRC (message "vc-working-revision2 %s" (vc-working-revision tmp-name)) - ;;(should (eq (vc-working-revision tmp-name) - ;;(vc-working-revision tmp-name backend))) - (should (member (vc-working-revision tmp-name) '(nil "0"))) + (should-not (vc-working-revision tmp-name)) ;; Write a new file. Check working revision. (write-region "foo" nil tmp-name nil 'nomessage) - ;; nil: CVS Git Mtn RCS SCCS SVN - ;; "0": Bzr Hg SRC (message "vc-working-revision3 %s" (vc-working-revision tmp-name)) - ;;(should (eq (vc-working-revision tmp-name) - ;;(vc-working-revision tmp-name backend))) - (should (member (vc-working-revision tmp-name) '(nil "0"))) + (should-not (vc-working-revision tmp-name)) ;; Register a file. Check working revision. (vc-register (list backend (list (file-name-nondirectory tmp-name)))) - ;; nil: Mtn Git RCS SCCS + ;; XXX: nil is fine, at least in Git's case, because + ;; `vc-register' only makes the file `added' in this case. + ;; nil: Git Mtn ;; "0": Bzr CVS Hg SRC SVN + ;; "1.1": RCS SCCS (message "vc-working-revision4 %s" (vc-working-revision tmp-name)) - ;;(should (eq (vc-working-revision tmp-name) - ;;(vc-working-revision tmp-name backend))) - (should (member (vc-working-revision tmp-name) '(nil "0"))) + (should (member (vc-working-revision tmp-name) '(nil "0" "1.1"))) + + ;; TODO: Call `vc-checkin', and check the resulting + ;; working revision. None of the return values should be + ;; nil then. ;; Unregister the file. Check working revision. - (condition-case nil - (progn - (vc-test--unregister-function backend tmp-name) - - ;; nil: Git RCS - ;; "0": Bzr Hg - ;; unsupported: CVS Mtn SCCS SRC SVN - (message - "vc-working-revision5 %s" (vc-working-revision tmp-name)) - ;;(should (eq (vc-working-revision tmp-name) - ;;(vc-working-revision tmp-name backend))) - (should (member (vc-working-revision tmp-name) '(nil "0")))) - (vc-not-supported (message "vc-working-revision5 unsupported"))))) + (if (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name) + 'vc-not-supported) + (message "vc-working-revision5 unsupported") + ;; nil: Bzr Git Hg RCS + ;; unsupported: CVS Mtn SCCS SRC SVN + (message "vc-working-revision5 %s" (vc-working-revision tmp-name)) + (should-not (vc-working-revision tmp-name))))) ;; Save exit. (ignore-errors (run-hooks 'vc-test--cleanup-hook))))) @@ -451,9 +449,8 @@ For backends which dont support it, `vc-not-supported' is signalled." (vc-test--create-repo-function backend) ;; Surprisingly, none of the backends returns 'announce. - ;; nil: RCS ;; implicit: Bzr CVS Git Hg Mtn SRC SVN - ;; locking: SCCS + ;; locking: RCS SCCS (message "vc-checkout-model1 %s" (vc-checkout-model backend default-directory)) @@ -461,11 +458,10 @@ For backends which dont support it, `vc-not-supported' is signalled." '(announce implicit locking))) (let ((tmp-name (expand-file-name "foo" default-directory))) - ;; Check checkout model of an empty file. + ;; Check checkout model of a nonexistent file. - ;; nil: RCS ;; implicit: Bzr CVS Git Hg Mtn SRC SVN - ;; locking: SCCS + ;; locking: RCS SCCS (message "vc-checkout-model2 %s" (vc-checkout-model backend tmp-name)) (should (memq (vc-checkout-model backend tmp-name) @@ -474,9 +470,8 @@ For backends which dont support it, `vc-not-supported' is signalled." ;; Write a new file. Check checkout model. (write-region "foo" nil tmp-name nil 'nomessage) - ;; nil: RCS ;; implicit: Bzr CVS Git Hg Mtn SRC SVN - ;; locking: SCCS + ;; locking: RCS SCCS (message "vc-checkout-model3 %s" (vc-checkout-model backend tmp-name)) (should (memq (vc-checkout-model backend tmp-name) @@ -486,27 +481,25 @@ For backends which dont support it, `vc-not-supported' is signalled." (vc-register (list backend (list (file-name-nondirectory tmp-name)))) - ;; nil: RCS ;; implicit: Bzr CVS Git Hg Mtn SRC SVN - ;; locking: SCCS + ;; locking: RCS SCCS (message "vc-checkout-model4 %s" (vc-checkout-model backend tmp-name)) (should (memq (vc-checkout-model backend tmp-name) '(announce implicit locking))) ;; Unregister the file. Check checkout model. - (condition-case nil - (progn - (vc-test--unregister-function backend tmp-name) - - ;; nil: RCS - ;; implicit: Bzr Git Hg - ;; unsupported: CVS Mtn SCCS SRC SVN - (message - "vc-checkout-model5 %s" (vc-checkout-model backend tmp-name)) - (should (memq (vc-checkout-model backend tmp-name) - '(announce implicit locking)))) - (vc-not-supported (message "vc-checkout-model5 unsupported"))))) + (if (eq (vc-test--run-maybe-unsupported-function + 'vc-test--unregister-function backend tmp-name) + 'vc-not-supported) + (message "vc-checkout-model5 unsupported") + ;; implicit: Bzr Git Hg + ;; locking: RCS + ;; unsupported: CVS Mtn SCCS SRC SVN + (message + "vc-checkout-model5 %s" (vc-checkout-model backend tmp-name)) + (should (memq (vc-checkout-model backend tmp-name) + '(announce implicit locking)))))) ;; Save exit. (ignore-errors (run-hooks 'vc-test--cleanup-hook))))) @@ -605,8 +598,6 @@ For backends which dont support it, `vc-not-supported' is signalled." ,(intern (format "vc-test-%s04-checkout-model" backend-string)) () ,(format "Check `vc-checkout-model' for the %s backend." backend-string) - ;; FIXME make this pass. - :expected-result ,(if (equal backend 'RCS) :failed :passed) (skip-unless (ert-test-passed-p (ert-test-most-recent-result diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el new file mode 100644 index 00000000000..ffd2e65d9ae --- /dev/null +++ b/test/lisp/whitespace-tests.el @@ -0,0 +1,52 @@ +;;; whitespace-tests.el --- Test suite for whitespace -*- lexical-binding: t -*- + +;; Copyright (C) 2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'whitespace) + +(defun whitespace-tests--cleanup-string (string) + (with-temp-buffer + (insert string) + (whitespace-cleanup) + (buffer-string))) + +(ert-deftest whitespace-cleanup-eob () + (let ((whitespace-style '(empty))) + (should (equal (whitespace-tests--cleanup-string "a\n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "a\n\n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "a\n\t\n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "a\n\t \n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "a\n\t \n\n") + "a\n")) + (should (equal (whitespace-tests--cleanup-string "\n\t\n") + "")) + ;; Whitespace at end of non-empty line is not covered by the + ;; `empty' style. + (should (equal (whitespace-tests--cleanup-string "a \n\t \n\n") + "a \n")))) + +(provide 'whitespace-tests) + +;;; whitespace-tests.el ends here diff --git a/test/automated/xml-parse-tests.el b/test/lisp/xml-tests.el index 488d2c6f920..488d2c6f920 100644 --- a/test/automated/xml-parse-tests.el +++ b/test/lisp/xml-tests.el diff --git a/test/automated/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el index c7e835c0311..c7e835c0311 100644 --- a/test/automated/xt-mouse-tests.el +++ b/test/lisp/xt-mouse-tests.el diff --git a/test/make-test-deps.emacs-lisp b/test/make-test-deps.emacs-lisp new file mode 100644 index 00000000000..9edeef3d2a8 --- /dev/null +++ b/test/make-test-deps.emacs-lisp @@ -0,0 +1,98 @@ +;; -*- emacs-lisp -*- + +;; Copyright (C) 2015-2016 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file generates dependencies between test files and the files +;; that they test. + +;; It has an .emacs-lisp extension because it makes the Makefile easier! + +(require 'seq) + +(defun make-test-deps (src-dir) + (let ((src-dir (file-truename src-dir))) + (message + "%s" + (concat + (make-test-deps-lisp src-dir) + (make-test-deps-src src-dir))))) + +(defun make-test-deps-lisp (src-dir) + (mapconcat + (lambda (file-without-suffix) + (format "./%s-tests.log: %s/../%s.el\n" + file-without-suffix + src-dir + file-without-suffix)) + (make-test-test-files src-dir "lisp") "")) + +(defun make-test-deps-src (src-dir) + (mapconcat + (lambda (file-without-suffix) + (format "./%s-tests.log: %s/../%s.c\n" + file-without-suffix + src-dir + file-without-suffix)) + (make-test-test-files src-dir "src") "")) + +(defun make-test-test-files (src-dir sub-src-dir) + (make-test-munge-files + src-dir + (directory-files-recursively + (concat src-dir "/" sub-src-dir) + ".*-tests.el$"))) + +(defun make-test-munge-files (src-dir files) + (make-test-sans-suffix + (make-test-de-stem + src-dir + (make-test-no-legacy + (make-test-no-test-dir + (make-test-no-resources + files)))))) + +(defun make-test-sans-suffix (files) + (mapcar + (lambda (file) + (substring file 0 -9)) + files)) + +(defun make-test-de-stem (stem files) + (mapcar + (lambda (file) + (substring + file + (+ 1 (length stem)))) + files)) + +(defun make-test-no-legacy (list) + (make-test-remove list "legacy/")) + +(defun make-test-no-resources (list) + (make-test-remove list "-resources/")) + +(defun make-test-no-test-dir (list) + (make-test-remove list "-tests/")) + +(defun make-test-remove (list match) + (seq-remove + (lambda (file) + (string-match-p match file)) + list)) diff --git a/test/BidiCharacterTest.txt b/test/manual/BidiCharacterTest.txt index 7a460b48afa..7e04d6cb3c0 100644 --- a/test/BidiCharacterTest.txt +++ b/test/manual/BidiCharacterTest.txt @@ -1,13 +1,14 @@ -# BidiCharacterTest-8.0.0.txt -# Date: 2015-02-19, 00:30:00 GMT [LI] +# BidiCharacterTest-9.0.0.txt +# Date: 2016-01-15, 22:30:00 GMT [LI] +# © 2016 Unicode®, Inc. +# For terms of use, see http://www.unicode.org/terms_of_use.html # # Unicode Character Database -# Copyright (c) 1991-2015 Unicode, Inc. -# For terms of use, see http://www.unicode.org/terms_of_use.html +# For documentation, see http://www.unicode.org/reports/tr44/ # # This file provides a conformance test for implementations of the # Unicode Bidirectional Algorithm, specified in UAX #9: Unicode -# Bidirectional Algorithm, at http://www.unicode.org/unicode/reports/tr9/ +# Bidirectional Algorithm, at http://www.unicode.org/reports/tr9/ # # The test data has been generated with a few constraints. Each test case # is a single paragraph, so the test data does not contain any characters @@ -34,6 +35,7 @@ # # Comment lines start with '#'. +################################################################################ # Examples from UAX #9 # Examples from Section 3.3.5 @@ -50,6 +52,48 @@ 0627 0628 062C 0020 0062 006F 006F 006B 0028 0073 0029;0;0;1 1 1 0 0 0 0 0 0 0 0;2 1 0 3 4 5 6 7 8 9 10 0627 0628 062C 0020 0062 006F 006F 006B 0028 0073 0029;1;1;1 1 1 1 2 2 2 2 2 2 2;4 5 6 7 8 9 10 3 2 1 0 +################################################################################ +# Test cases for the algorithm changes and clarifications made in Unicode 8.0 + +# Explicit directional overrides applied to isolates tightly flanked by embeddings +202E 0061 202A 0062 202C 2066 0063 2069 202A 0064 202C 0065 202C;2;0;x 1 x 2 x 1 2 1 x 2 x 1 x;11 9 7 6 5 3 1 +202E 0061 202A 0062 202C 2066 0063 2069 202A 0064 202C 0065 202C;1;1;x 3 x 4 x 3 4 3 x 4 x 3 x;11 9 7 6 5 3 1 +202D 05D0 202B 05D1 202C 2068 05D2 2069 202B 05D3 202C 05D4 202C;2;1;x 2 x 3 x 2 3 2 x 3 x 2 x;1 3 5 6 7 9 11 +202D 0661 202B 0662 202C 2068 0663 2069 202B 0664 202C 0665 202C;0;0;x 2 x 4 x 2 6 2 x 4 x 2 x;1 3 5 6 7 9 11 + +# Explicit directional overrides applied to paired brackets +202A 05D0 0028 05D1 202C 202D 0029;2;1;x 3 3 3 x x 2;3 2 1 6 +202A 05D0 0028 05D1 202C 202D 0029 202C;2;1;x 3 3 3 x x 2 x;3 2 1 6 +202B 0061 0028 0062 202C 202E 0029;2;0;x 2 2 2 x x 1;6 1 2 3 +202B 0061 0028 0062 202C 202E 0029 202C;2;0;x 2 2 2 x x 1 x;6 1 2 3 +202A 202E 0061 202C 0028 05D0 202C 202D 0029 202C;2;0;x x 3 x 3 3 x x 2 x;5 4 2 8 +202B 202D 05D0 202C 0028 0061 202C 202E 0029 202C;2;1;x x 4 x 4 4 x x 3 x;8 2 4 5 +202A 202E 0061 202C 0028 005B 05D0 202C 202D 005D 0029 202C;2;0;x x 3 x 3 3 3 x x 2 2 x;6 5 4 2 9 10 +202B 202D 05D0 202C 0028 005B 0061 202C 202E 005D 0029 202C;2;1;x x 4 x 4 4 4 x x 3 3 x;10 9 2 4 5 6 +202D 0028 202C 202A 05D0 0029 05D1;2;1;x 2 x x 3 3 3;1 6 5 4 +202D 0028 202C 202A 05D0 0029 05D1 202C;2;1;x 2 x x 3 3 3 x;1 6 5 4 +202E 0028 202C 202B 0061 0029 0062;2;0;x 1 x x 2 2 2;4 5 6 1 +202E 0028 202C 202B 0061 0029 0062 202C;2;0;x 1 x x 2 2 2 x;4 5 6 1 +202D 202E 0061 202C 0028 202C 202A 05D0 0029 05D1;2;0;x x 3 x 2 x x 3 3 3;2 4 9 8 7 +202E 202D 05D0 202C 0028 202C 202B 0061 0029 0062;2;1;x x 4 x 3 x x 4 4 4;7 8 9 4 2 +202D 202E 0061 202C 0028 005B 202C 202A 05D0 005D 0029 05D1;2;0;x x 3 x 2 2 x x 3 3 3 3;2 4 5 11 10 9 8 +202E 202D 05D0 202C 0028 005B 202C 202B 0061 005D 0029 0062;2;1;x x 4 x 3 3 x x 4 4 4 4;8 9 10 11 5 4 2 + +# Nonspacing marks applied to paired brackets +0061 0028 0062 0029 0331;1;1;2 2 2 2 2;0 1 2 3 4 +0061 0028 0332 0062 0029 0333;1;1;2 2 2 2 2 2;0 1 2 3 4 5 +05D0 0028 05D1 0029 0331;0;0;1 1 1 1 1;4 3 2 1 0 +05D0 0028 0332 05D1 0029 0333;0;0;1 1 1 1 1 1;5 4 3 2 1 0 +0661 0028 0662 0029 0331;0;0;2 1 2 1 1;4 3 2 1 0 +0661 0028 0332 0662 0029 0333;0;0;2 1 1 2 1 1;5 4 3 2 1 0 + +# Nested bracket pairs that reach and exceed the fixed capacity of the bracket stack +# a ( ( ... ( b ) ) ... ) with 62, 63, and 64 nested bracket pairs +0061 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0062 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029;1;1;2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2;0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 +0061 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0062 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029;1;1;2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2;0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 +0061 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0028 0062 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029 0029;1;1;2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1;129 128 127 126 125 124 123 122 121 120 119 118 117 116 115 114 113 112 111 110 109 108 107 106 105 104 103 102 101 100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 + +################################################################################ # Miscellaneous test cases # Various sequences @@ -246,6 +290,7 @@ 05D0 0020 2329 05D1 002E 0031 3009;0;0;1 1 1 1 1 2 1;6 5 4 3 2 1 0 05D0 0020 3008 05D1 002E 0031 232A;0;0;1 1 1 1 1 2 1;6 5 4 3 2 1 0 +################################################################################ # Permutations of sequences containing paired brackets # The sequences in this section consist of permutation patterns of three diff --git a/test/biditest.el b/test/manual/biditest.el index 3545c50734f..c1a575017f8 100644 --- a/test/biditest.el +++ b/test/manual/biditest.el @@ -46,7 +46,7 @@ The resulting file should be viewed with `inhibit-bidi-mirroring' set to t." (insert-file-contents input-file) (goto-char (point-min)) (while (not (eobp)) - (when (looking-at "^\\([0-9A-F ]+\\);\\([012]\\);\\([01]\\);\\([0-9 ]+\\);\\([0-9 ]+\\)$") + (when (looking-at "^\\([0-9A-F ]+\\);\\([012]\\);\\([01]\\);\\([0-9x ]+\\);\\([0-9 ]+\\)$") (let ((codes (match-string 1)) (default-paragraph (match-string 2)) (resolved-paragraph (match-string 3)) diff --git a/test/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el index ae9d576f0f5..ae9d576f0f5 100644 --- a/test/cedet/cedet-utests.el +++ b/test/manual/cedet/cedet-utests.el diff --git a/test/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el index 32971e441ef..32971e441ef 100644 --- a/test/cedet/ede-tests.el +++ b/test/manual/cedet/ede-tests.el diff --git a/test/cedet/semantic-ia-utest.el b/test/manual/cedet/semantic-ia-utest.el index a5b70b8326f..a5b70b8326f 100644 --- a/test/cedet/semantic-ia-utest.el +++ b/test/manual/cedet/semantic-ia-utest.el diff --git a/test/cedet/semantic-tests.el b/test/manual/cedet/semantic-tests.el index 179851fafeb..179851fafeb 100644 --- a/test/cedet/semantic-tests.el +++ b/test/manual/cedet/semantic-tests.el diff --git a/test/cedet/semantic-utest-c.el b/test/manual/cedet/semantic-utest-c.el index ec09b96211f..ec09b96211f 100644 --- a/test/cedet/semantic-utest-c.el +++ b/test/manual/cedet/semantic-utest-c.el diff --git a/test/cedet/semantic-utest.el b/test/manual/cedet/semantic-utest.el index d26d6118d2d..d26d6118d2d 100644 --- a/test/cedet/semantic-utest.el +++ b/test/manual/cedet/semantic-utest.el diff --git a/test/cedet/srecode-tests.el b/test/manual/cedet/srecode-tests.el index 18beb9291fa..18beb9291fa 100644 --- a/test/cedet/srecode-tests.el +++ b/test/manual/cedet/srecode-tests.el diff --git a/test/cedet/tests/test.c b/test/manual/cedet/tests/test.c index 0aa8852b8a9..0aa8852b8a9 100644 --- a/test/cedet/tests/test.c +++ b/test/manual/cedet/tests/test.c diff --git a/test/cedet/tests/test.el b/test/manual/cedet/tests/test.el index 0b8f9dee619..15517da0dc2 100644 --- a/test/cedet/tests/test.el +++ b/test/manual/cedet/tests/test.el @@ -89,7 +89,7 @@ (defconst a-defconst 'a "var doc const") (defcustom a-defcustom nil - "*doc custom" + "doc custom" :group 'a-defgroup :type 'boolean) diff --git a/test/cedet/tests/test.make b/test/manual/cedet/tests/test.make index 1eb71f7ccc8..1eb71f7ccc8 100644 --- a/test/cedet/tests/test.make +++ b/test/manual/cedet/tests/test.make diff --git a/test/cedet/tests/testdoublens.cpp b/test/manual/cedet/tests/testdoublens.cpp index 63c4deedd08..63c4deedd08 100644 --- a/test/cedet/tests/testdoublens.cpp +++ b/test/manual/cedet/tests/testdoublens.cpp diff --git a/test/cedet/tests/testdoublens.hpp b/test/manual/cedet/tests/testdoublens.hpp index 6d2a0f0755e..6d2a0f0755e 100644 --- a/test/cedet/tests/testdoublens.hpp +++ b/test/manual/cedet/tests/testdoublens.hpp diff --git a/test/cedet/tests/testfriends.cpp b/test/manual/cedet/tests/testfriends.cpp index 20425f93afa..20425f93afa 100644 --- a/test/cedet/tests/testfriends.cpp +++ b/test/manual/cedet/tests/testfriends.cpp diff --git a/test/cedet/tests/testjavacomp.java b/test/manual/cedet/tests/testjavacomp.java index f0abfc97b06..f0abfc97b06 100644 --- a/test/cedet/tests/testjavacomp.java +++ b/test/manual/cedet/tests/testjavacomp.java diff --git a/test/cedet/tests/testnsp.cpp b/test/manual/cedet/tests/testnsp.cpp index 012dc660600..012dc660600 100644 --- a/test/cedet/tests/testnsp.cpp +++ b/test/manual/cedet/tests/testnsp.cpp diff --git a/test/cedet/tests/testpolymorph.cpp b/test/manual/cedet/tests/testpolymorph.cpp index 94ae9d90413..94ae9d90413 100644 --- a/test/cedet/tests/testpolymorph.cpp +++ b/test/manual/cedet/tests/testpolymorph.cpp diff --git a/test/cedet/tests/testspp.c b/test/manual/cedet/tests/testspp.c index cfb3996db47..cfb3996db47 100644 --- a/test/cedet/tests/testspp.c +++ b/test/manual/cedet/tests/testspp.c diff --git a/test/cedet/tests/testsppcomplete.c b/test/manual/cedet/tests/testsppcomplete.c index d7899942285..d7899942285 100644 --- a/test/cedet/tests/testsppcomplete.c +++ b/test/manual/cedet/tests/testsppcomplete.c diff --git a/test/cedet/tests/testsppreplace.c b/test/manual/cedet/tests/testsppreplace.c index fbbaa75fee1..fbbaa75fee1 100644 --- a/test/cedet/tests/testsppreplace.c +++ b/test/manual/cedet/tests/testsppreplace.c diff --git a/test/cedet/tests/testsppreplaced.c b/test/manual/cedet/tests/testsppreplaced.c index 8cbe05bd4f7..8cbe05bd4f7 100644 --- a/test/cedet/tests/testsppreplaced.c +++ b/test/manual/cedet/tests/testsppreplaced.c diff --git a/test/cedet/tests/testsubclass.cpp b/test/manual/cedet/tests/testsubclass.cpp index 2cb9e763888..2cb9e763888 100644 --- a/test/cedet/tests/testsubclass.cpp +++ b/test/manual/cedet/tests/testsubclass.cpp diff --git a/test/cedet/tests/testsubclass.hh b/test/manual/cedet/tests/testsubclass.hh index 7c93f8ec02d..7c93f8ec02d 100644 --- a/test/cedet/tests/testsubclass.hh +++ b/test/manual/cedet/tests/testsubclass.hh diff --git a/test/cedet/tests/testtypedefs.cpp b/test/manual/cedet/tests/testtypedefs.cpp index 312a77f0058..312a77f0058 100644 --- a/test/cedet/tests/testtypedefs.cpp +++ b/test/manual/cedet/tests/testtypedefs.cpp diff --git a/test/cedet/tests/testvarnames.c b/test/manual/cedet/tests/testvarnames.c index 419361d1dbc..419361d1dbc 100644 --- a/test/cedet/tests/testvarnames.c +++ b/test/manual/cedet/tests/testvarnames.c diff --git a/test/etags/CTAGS.good b/test/manual/etags/CTAGS.good index d392b691dcb..6f9df192c43 100644 --- a/test/etags/CTAGS.good +++ b/test/manual/etags/CTAGS.good @@ -36,7 +36,8 @@ ${CHECKOBJS} make-src/Makefile /^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/ ($prog,$_,@list perl-src/yagrip.pl 39 ($string,$flag,@string,@temp,@last perl-src/yagrip.pl 40 (a-forth-constant forth-src/test-forth.fth /^constant (a-forth-constant$/ -(another-forth-word forth-src/test-forth.fth /^: (another-forth-word) ( -- )$/ +(another-forth-word) forth-src/test-forth.fth /^: (another-forth-word) ( -- )$/ +(foo) forth-src/test-forth.fth /^: (foo) 1 ;$/ + ruby-src/test.rb /^ def +(y)$/ + tex-src/texinfo.tex /^\\def+{{\\tt \\char 43}}$/ .PRECIOUS make-src/Makefile /^.PRECIOUS: ETAGS CTAGS ETAGS16 CTAGS16 ETAGS17 CTA/ @@ -170,6 +171,9 @@ ${CHECKOBJS} make-src/Makefile /^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/ /wbytes ps-src/rfc1245.ps /^\/wbytes { $/ /wh ps-src/rfc1245.ps /^\/wh { $/ /yen ps-src/rfc1245.ps /^\/yen \/.notdef \/.notdef \/.notdef \/.notdef \/.notdef / +2const forth-src/test-forth.fth /^3 4 2constant 2const$/ +2val forth-src/test-forth.fth /^2const 2value 2val$/ +2var forth-src/test-forth.fth /^2variable 2var$/ :a-forth-dictionary-entry forth-src/test-forth.fth /^create :a-forth-dictionary-entry$/ < tex-src/texinfo.tex /^\\def<{{\\tt \\less}}$/ << ruby-src/test.rb /^ def <<(y)$/ @@ -351,7 +355,6 @@ CHAR_TABLE_REF c-src/emacs/src/lisp.h /^CHAR_TABLE_REF (Lisp_Object ct, int idx) CHAR_TABLE_REF_ASCII c-src/emacs/src/lisp.h /^CHAR_TABLE_REF_ASCII (Lisp_Object ct, ptrdiff_t id/ CHAR_TABLE_SET c-src/emacs/src/lisp.h /^CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Obje/ CHAR_TABLE_STANDARD_SLOTS c-src/emacs/src/lisp.h 1697 -CHAR_TYPE_SIZE cccp.y 87 CHAR_TYPE_SIZE y-src/cccp.y 87 CHECKFLAGS make-src/Makefile /^CHECKFLAGS=-DDEBUG -Wno-unused-function$/ CHECKOBJS make-src/Makefile /^CHECKOBJS=chkmalloc.o chkxm.o$/ @@ -383,13 +386,9 @@ CHECK_VECTOR c-src/emacs/src/lisp.h /^CHECK_VECTOR (Lisp_Object x)$/ CHECK_VECTOR_OR_STRING c-src/emacs/src/lisp.h /^CHECK_VECTOR_OR_STRING (Lisp_Object x)$/ CHECK_WINDOW c-src/emacs/src/lisp.h /^CHECK_WINDOW (Lisp_Object x)$/ CK_ABS_C y-src/parse.y /^#define CK_ABS_C(x) if((x)<MIN_COL || (x)>MAX_COL)/ -CK_ABS_C parse.y /^#define CK_ABS_C(x) if((x)<MIN_COL || (x)>MAX_COL)/ CK_ABS_R y-src/parse.y /^#define CK_ABS_R(x) if((x)<MIN_ROW || (x)>MAX_ROW)/ -CK_ABS_R parse.y /^#define CK_ABS_R(x) if((x)<MIN_ROW || (x)>MAX_ROW)/ CK_REL_C y-src/parse.y /^#define CK_REL_C(x) if( ((x)>0 && MAX_COL-(x)<cu/ -CK_REL_C parse.y /^#define CK_REL_C(x) if( ((x)>0 && MAX_COL-(x)<cu/ CK_REL_R y-src/parse.y /^#define CK_REL_R(x) if( ((x)>0 && MAX_ROW-(x)<cu/ -CK_REL_R parse.y /^#define CK_REL_R(x) if( ((x)>0 && MAX_ROW-(x)<cu/ CMultiChannelCSC19_3D cp-src/c.C 2 CNL c-src/etags.c /^#define CNL() \\$/ CNL_SAVE_DEFINEDEF c-src/etags.c /^#define CNL_SAVE_DEFINEDEF() \\$/ @@ -550,7 +549,6 @@ EQ c-src/emacs/src/lisp.h /^# define EQ(x, y) lisp_h_EQ (x, y)$/ EQUAL y-src/cccp.c 12 ERLSRC make-src/Makefile /^ERLSRC=gs_dialog.erl lines.erl lists.erl$/ ERROR y-src/parse.y 303 -ERROR parse.y 303 ERROR y-src/cccp.c 9 ETAGS make-src/Makefile /^ETAGS: FRC etags ${infiles}$/ ETAGS% make-src/Makefile /^ETAGS%: FRC etags% ${infiles}$/ @@ -588,15 +586,10 @@ FRC make-src/Makefile /^FRC:;$/ FREEFLOOD c-src/emacs/src/gmalloc.c 1858 FSRC make-src/Makefile /^FSRC=entry.for entry.strange_suffix entry.strange$/ FUN0 y-src/parse.y /^yylex FUN0()$/ -FUN0 parse.y /^yylex FUN0()$/ FUN1 y-src/parse.y /^yyerror FUN1(char *, s)$/ FUN1 y-src/parse.y /^str_to_col FUN1(char **,str)$/ -FUN1 parse.y /^yyerror FUN1(char *, s)$/ -FUN1 parse.y /^str_to_col FUN1(char **,str)$/ FUN2 y-src/parse.y /^make_list FUN2(YYSTYPE, car, YYSTYPE, cdr)$/ FUN2 y-src/parse.y /^parse_cell_or_range FUN2(char **,ptr, struct rng */ -FUN2 parse.y /^make_list FUN2(YYSTYPE, car, YYSTYPE, cdr)$/ -FUN2 parse.y /^parse_cell_or_range FUN2(char **,ptr, struct rng */ FUNCTIONP c-src/emacs/src/lisp.h /^FUNCTIONP (Lisp_Object obj)$/ FUNCTION_KEY_OFFSET c-src/emacs/src/keyboard.c 4766 FUNCTION_KEY_OFFSET c-src/emacs/src/keyboard.c 5061 @@ -695,8 +688,6 @@ GC_MARK_STACK_CHECK_GCPROS c-src/emacs/src/lisp.h 3173 GC_USE_GCPROS_AS_BEFORE c-src/emacs/src/lisp.h 3171 GC_USE_GCPROS_CHECK_ZOMBIES c-src/emacs/src/lisp.h 3174 GE y-src/parse.c 8 -GENERIC_PTR cccp.y 56 -GENERIC_PTR cccp.y 58 GENERIC_PTR y-src/cccp.y 56 GENERIC_PTR y-src/cccp.y 58 GEQ y-src/cccp.c 15 @@ -740,7 +731,6 @@ INTERVAL c-src/emacs/src/lisp.h 1149 INTMASK c-src/emacs/src/lisp.h 437 INTTYPEBITS c-src/emacs/src/lisp.h 249 INT_BIT c-src/emacs/src/gmalloc.c 124 -INT_TYPE_SIZE cccp.y 91 INT_TYPE_SIZE y-src/cccp.y 91 ISALNUM c-src/etags.c /^#define ISALNUM(c) isalnum (CHAR (c))$/ ISALPHA c-src/etags.c /^#define ISALPHA(c) isalpha (CHAR (c))$/ @@ -833,7 +823,6 @@ LOCK c-src/emacs/src/gmalloc.c /^#define LOCK() \\$/ LOCK c-src/emacs/src/gmalloc.c /^#define LOCK()$/ LOCK_ALIGNED_BLOCKS c-src/emacs/src/gmalloc.c /^#define LOCK_ALIGNED_BLOCKS() \\$/ LOCK_ALIGNED_BLOCKS c-src/emacs/src/gmalloc.c /^#define LOCK_ALIGNED_BLOCKS()$/ -LONG_TYPE_SIZE cccp.y 95 LONG_TYPE_SIZE y-src/cccp.y 95 LOOKING_AT c-src/etags.c /^#define LOOKING_AT(cp, kw) \/* kw is the keyword, / LOOKING_AT_NOCASE c-src/etags.c /^#define LOOKING_AT_NOCASE(cp, kw) \/* the keyword i/ @@ -945,7 +934,6 @@ MAX_ENCODED_BYTES c-src/emacs/src/keyboard.c 2254 MAX_HASH_VALUE c-src/etags.c 2329 MAX_WORD_LENGTH c-src/etags.c 2327 MAYBEREL y-src/parse.y /^#define MAYBEREL(p) (*(p)=='[' && (isdigit((p)[1])/ -MAYBEREL parse.y /^#define MAYBEREL(p) (*(p)=='[' && (isdigit((p)[1])/ MBYTES objc-src/PackInsp.m 59 MCHECK_DISABLED c-src/emacs/src/gmalloc.c 285 MCHECK_FREE c-src/emacs/src/gmalloc.c 287 @@ -988,7 +976,6 @@ Makefile_filenames c-src/etags.c 603 Makefile_help c-src/etags.c 605 Makefile_targets c-src/etags.c /^Makefile_targets (FILE *inf)$/ Mc cp-src/c.C /^int main (void) { my_function0(0); my_function1(1)/ -Mcccp cccp.y /^main ()$/ Mcccp y-src/cccp.y /^main ()$/ Mconway.cpp cp-src/conway.cpp /^void main(void)$/ Metags c-src/etags.c /^main (int argc, char **argv)$/ @@ -1017,9 +1004,7 @@ NONPOINTER_BITS c-src/emacs/src/lisp.h 78 NONPOINTER_BITS c-src/emacs/src/lisp.h 80 NONSRCS make-src/Makefile /^NONSRCS=entry.strange lists.erl clheir.hpp.gz$/ NOTEQUAL y-src/cccp.c 13 -NULL cccp.y 51 NULL y-src/cccp.y 51 -NULL_PTR cccp.y 63 NULL_PTR y-src/cccp.y 63 NUMSTATS objc-src/PackInsp.h 36 NUM_MOD_NAMES c-src/emacs/src/keyboard.c 6325 @@ -1490,7 +1475,6 @@ USE_STACK_LISP_OBJECTS c-src/emacs/src/lisp.h 4652 USE_STACK_LISP_OBJECTS c-src/emacs/src/lisp.h 4658 USE_STACK_LISP_OBJECTS c-src/emacs/src/lisp.h 4659 USE_STACK_STRING c-src/emacs/src/lisp.h 4691 -U_CHAR cccp.y 38 U_CHAR y-src/cccp.y 38 Unlock/p ada-src/2ataspri.adb /^ procedure Unlock (L : in out Lock) is$/ Unlock/p ada-src/2ataspri.ads /^ procedure Unlock (L : in out Lock);$/ @@ -1520,7 +1504,6 @@ Vpre_abbrev_expand_hook c-src/abbrev.c 83 WAIT_READING_MAX c-src/emacs/src/lisp.h 4281 WAIT_READING_MAX c-src/emacs/src/lisp.h 4283 WARNINGS make-src/Makefile /^WARNINGS=-pedantic -Wall -Wpointer-arith -Winline / -WCHAR_TYPE_SIZE cccp.y 99 WCHAR_TYPE_SIZE y-src/cccp.y 99 WHITE cp-src/screen.hpp 27 WINDOWP c-src/emacs/src/lisp.h /^WINDOWP (Lisp_Object a)$/ @@ -1622,8 +1605,6 @@ YYBACKUP /usr/share/bison/bison.simple /^#define YYBACKUP(Token, Value) \\$/ YYBACKUP /usr/share/bison/bison.simple /^#define YYBACKUP(Token, Value) \\$/ YYBISON y-src/parse.c 4 YYBISON y-src/cccp.c 4 -YYDEBUG parse.y 88 -YYDEBUG cccp.y 122 YYDPRINTF /usr/share/bison/bison.simple /^# define YYDPRINTF(Args) \\$/ YYDPRINTF /usr/share/bison/bison.simple /^# define YYDPRINTF(Args)$/ YYDPRINTF /usr/share/bison/bison.simple /^# define YYDPRINTF(Args) \\$/ @@ -1638,16 +1619,10 @@ YYERROR /usr/share/bison/bison.simple 154 YYERROR /usr/share/bison/bison.simple 155 YYFAIL /usr/share/bison/bison.simple 158 YYFAIL /usr/share/bison/bison.simple 159 -YYFINAL parse.y 93 -YYFINAL cccp.y 127 -YYFLAG parse.y 94 -YYFLAG cccp.y 128 YYFPRINTF /usr/share/bison/bison.simple 225 YYFPRINTF /usr/share/bison/bison.simple 226 YYINITDEPTH /usr/share/bison/bison.simple 244 YYINITDEPTH /usr/share/bison/bison.simple 245 -YYLAST parse.y 266 -YYLAST cccp.y 274 YYLEX /usr/share/bison/bison.simple 200 YYLEX /usr/share/bison/bison.simple 202 YYLEX /usr/share/bison/bison.simple 206 @@ -1664,8 +1639,6 @@ YYMAXDEPTH /usr/share/bison/bison.simple 255 YYMAXDEPTH /usr/share/bison/bison.simple 259 YYMAXDEPTH /usr/share/bison/bison.simple 256 YYMAXDEPTH /usr/share/bison/bison.simple 260 -YYNTBASE parse.y 95 -YYNTBASE cccp.y 129 YYPARSE_PARAM_ARG /usr/share/bison/bison.simple 351 YYPARSE_PARAM_ARG /usr/share/bison/bison.simple 354 YYPARSE_PARAM_ARG /usr/share/bison/bison.simple 358 @@ -1730,14 +1703,8 @@ YYSTD /usr/share/bison/bison.simple /^# define YYSTD(x) std::x$/ YYSTD /usr/share/bison/bison.simple /^# define YYSTD(x) x$/ YYSTYPE y-src/parse.y 71 YYSTYPE y-src/parse.y 72 -YYSTYPE parse.y 71 -YYSTYPE parse.y 72 -YYSTYPE parse.y 85 -YYSTYPE cccp.y 119 YYTERROR /usr/share/bison/bison.simple 177 YYTERROR /usr/share/bison/bison.simple 178 -YYTRANSLATE parse.y /^#define YYTRANSLATE(x) ((unsigned)(x) <= 278 ? yyt/ -YYTRANSLATE cccp.y /^#define YYTRANSLATE(x) ((unsigned)(x) <= 269 ? yyt/ YY_DECL_NON_LSP_VARIABLES /usr/share/bison/bison.simple 374 YY_DECL_NON_LSP_VARIABLES /usr/share/bison/bison.simple 374 YY_DECL_VARIABLES /usr/share/bison/bison.simple 385 @@ -2512,7 +2479,6 @@ add_node c-src/etags.c /^add_node (node *np, node **cur_node_p)$/ add_regex c-src/etags.c /^add_regex (char *regexp_pattern, language *lang)$/ add_user_signal c-src/emacs/src/keyboard.c /^add_user_signal (int sig, const char *name)$/ addnoise html-src/algrthms.html /^Adding Noise to the$/ -address cccp.y 114 address y-src/cccp.y 113 adjust_point_for_property c-src/emacs/src/keyboard.c /^adjust_point_for_property (ptrdiff_t last_pt, bool/ agent cp-src/clheir.hpp 75 @@ -2552,9 +2518,7 @@ apply_modifiers_uncached c-src/emacs/src/keyboard.c /^apply_modifiers_uncached ( aref_addr c-src/emacs/src/lisp.h /^aref_addr (Lisp_Object array, ptrdiff_t idx)$/ arg c-src/h.h 13 arg_type c-src/etags.c 250 -arglist cccp.y 41 arglist y-src/cccp.y 41 -argno cccp.y 45 argno y-src/cccp.y 45 args c-src/h.h 30 argsindent tex-src/texinfo.tex /^\\newskip\\defargsindent \\defargsindent=50pt$/ @@ -2750,7 +2714,6 @@ concat c-src/etags.c /^concat (const char *s1, const char *s2, const char/ concatenatenamestrings pas-src/common.pas /^function concatenatenamestrings; (*($/ consider_token c-src/etags.c /^consider_token (char *str, int len, int c, int *c_/ constant c-src/h.h 29 -constant cccp.y 113 constant y-src/cccp.y 112 constant_args c-src/h.h 27 constype c-src/emacs/src/lisp.h 3739 @@ -2766,6 +2729,7 @@ counter cp-src/c.C 36 cow cp-src/c.C 127 cow cp-src/c.C 131 cplpl c-src/etags.c 2935 +create-bar forth-src/test-forth.fth /^: create-bar foo ;$/ createPOEntries php-src/lce_functions.php /^ function createPOEntries()$/ createWidgets pyt-src/server.py /^ def createWidgets(self, host):$/ createWidgets pyt-src/server.py /^ def createWidgets(self):$/ @@ -2905,7 +2869,6 @@ erlang_func c-src/etags.c /^erlang_func (char *s, char *last)$/ error c-src/etags.c /^static void error (const char *, ...) ATTRIBUTE_FO/ error c-src/etags.c /^error (const char *format, ...)$/ error c-src/emacs/src/lisp.h /^extern _Noreturn void error (const char *, ...) AT/ -error cccp.y /^error (msg)$/ error y-src/cccp.y /^error (msg)$/ error_signaled c-src/etags.c 264 etags el-src/emacs/lisp/progmodes/etags.el /^(defgroup etags nil "Tags tables."$/ @@ -2951,7 +2914,6 @@ expandmng_tree prol-src/natded.prolog /^expandmng_tree(tree(Rule,Syn:Sem,Trees), expandmng_trees prol-src/natded.prolog /^expandmng_trees([],[]).$/ expandsyn prol-src/natded.prolog /^expandsyn(Syn,Syn):-$/ explicitly-quoted-pending-delete-mode el-src/TAGTEST.EL /^(defalias (quote explicitly-quoted-pending-delete-/ -expression_value cccp.y 68 expression_value y-src/cccp.y 68 extras c-src/emacs/src/lisp.h 1603 extvar c-src/h.h 109 @@ -2987,6 +2949,7 @@ fastmap c-src/emacs/src/regex.h 355 fastmap_accurate c-src/emacs/src/regex.h 383 fatal c-src/etags.c /^fatal (const char *s1, const char *s2)$/ fatala c.c /^void fatala () __attribute__ ((noreturn));$/ +fconst forth-src/test-forth.fth /^3.1415e fconstant fconst$/ fdHandler objc-src/Subprocess.m /^- fdHandler:(int)theFd$/ fdHandler objc-src/Subprocess.m /^fdHandler (int theFd, id self)$/ fdefunkey c-src/etags.c 2409 @@ -3041,7 +3004,6 @@ flistseen c-src/etags.c 2415 fn c-src/exit.c /^ void EXFUN((*fn[1]), (NOARGS));$/ fn c-src/exit.strange_suffix /^ void EXFUN((*fn[1]), (NOARGS));$/ fnin y-src/parse.y 67 -fnin parse.y 67 focus_set pyt-src/server.py /^ def focus_set(self):$/ follow_key c-src/emacs/src/keyboard.c /^follow_key (Lisp_Object keymap, Lisp_Object key)$/ fonts tex-src/texinfo.tex /^\\obeyspaces \\obeylines \\ninett \\indexfonts \\rawbac/ @@ -3059,6 +3021,7 @@ foo cp-src/x.cc /^XX::foo()$/ foo f-src/entry.for /^ character*(*) function foo()$/ foo f-src/entry.strange_suffix /^ character*(*) function foo()$/ foo f-src/entry.strange /^ character*(*) function foo()$/ +foo forth-src/test-forth.fth /^: foo (foo) ;$/ foo php-src/ptest.php /^foo()$/ foo ruby-src/test1.ru /^ attr_reader :foo$/ foo! ruby-src/test1.ru /^ def foo!$/ @@ -3101,6 +3064,8 @@ function c-src/emacs/src/lisp.h 694 function c-src/emacs/src/lisp.h 1685 function c-src/emacs/src/lisp.h 2197 functionp c-src/emacs/src/lisp.h /^functionp (Lisp_Object object)$/ +fval forth-src/test-forth.fth /^fconst fvalue fval$/ +fvar forth-src/test-forth.fth /^fvariable fvar$/ fvdef c-src/etags.c 2418 fvextern c-src/etags.c 2420 fvnameseen c-src/etags.c 2412 @@ -3230,7 +3195,6 @@ inita c.c /^static void inita () {}$/ initb c.c /^static void initb () {}$/ initial_kboard c-src/emacs/src/keyboard.c 84 initialize-new-tags-table el-src/emacs/lisp/progmodes/etags.el /^(defun initialize-new-tags-table ()$/ -initialize_random_junk cccp.y /^initialize_random_junk ()$/ initialize_random_junk y-src/cccp.y /^initialize_random_junk ()$/ input-pending-p c-src/emacs/src/keyboard.c /^DEFUN ("input-pending-p", Finput_pending_p, Sinput/ input_available_clear_time c-src/emacs/src/keyboard.c 324 @@ -3244,13 +3208,10 @@ instance_method_equals= ruby-src/test.rb /^ def instance_method_equals=$/ instance_method_exclamation! ruby-src/test.rb /^ def instance_method_exclamation!$/ instance_method_question? ruby-src/test.rb /^ def instance_method_question?$/ instr y-src/parse.y 80 -instr parse.y 80 instruct c-src/etags.c 2527 intNumber go-src/test1.go 13 integer c-src/emacs/src/lisp.h 2127 -integer cccp.y 113 integer y-src/cccp.y 112 -integer_overflow cccp.y /^integer_overflow ()$/ integer_overflow y-src/cccp.y /^integer_overflow ()$/ integertonmstr pas-src/common.pas /^function integertonmstr; (* (TheInteger : integer)/ intensity1 f-src/entry.for /^ & intensity1(efv,fv,svin,svquad,sfpv,maxp,val/ @@ -3281,11 +3242,8 @@ isLeap cp-src/functions.cpp /^bool isLeap ( int year ){$/ is_curly_brace_form c-src/h.h 54 is_explicit c-src/h.h 49 is_func c-src/etags.c 221 -is_hor_space cccp.y 953 is_hor_space y-src/cccp.y 953 -is_idchar cccp.y 948 is_idchar y-src/cccp.y 948 -is_idstart cccp.y 950 is_idstart y-src/cccp.y 950 is_muldiv_operation cp-src/c.C /^is_muldiv_operation(pc)$/ is_ordset prol-src/ordsets.prolog /^is_ordset(X) :- var(X), !, fail.$/ @@ -3318,9 +3276,7 @@ keyval prol-src/natded.prolog /^keyval(key(Key,Val)) --> [Key,'='], valseq(Val). keyvalcgi prol-src/natded.prolog /^keyvalcgi(Key,Val):-$/ keyvalscgi prol-src/natded.prolog /^keyvalscgi(KeyVals),$/ keyvalseq prol-src/natded.prolog /^keyvalseq([KeyVal|KeyVals]) --> $/ -keyword_parsing cccp.y 73 keyword_parsing y-src/cccp.y 73 -keywords cccp.y 115 keywords y-src/cccp.y 114 keywords y-src/cccp.y 306 kind c-src/emacs/src/keyboard.c 11024 @@ -3369,12 +3325,9 @@ lce_textdomain php-src/lce_functions.php /^ function lce_textdomain($domain lce_textdomain php-src/lce_functions.php /^ function lce_textdomain($domain)$/ leasqr html-src/software.html /^Leasqr$/ left c-src/etags.c 216 -left_shift cccp.y /^left_shift (a, b)$/ left_shift y-src/cccp.y /^left_shift (a, b)$/ len c-src/etags.c 237 length c-src/etags.c 2495 -length cccp.y 44 -length cccp.y 114 length y-src/cccp.y 44 length y-src/cccp.y 113 letter tex-src/texinfo.tex /^\\chapmacro {#1}{Appendix \\appendixletter}%$/ @@ -3388,7 +3341,6 @@ letter tex-src/texinfo.tex /^ {\\appendixletter}$/ letter: tex-src/texinfo.tex /^\\xdef\\thischapter{Appendix \\appendixletter: \\noexp/ level c-src/emacs/src/lisp.h 3153 lex prol-src/natded.prolog /^lex(W,SynOut,Sem):-$/ -lexptr cccp.y 332 lexptr y-src/cccp.y 332 licenze html-src/softwarelibero.html /^Licenze d'uso di un programma$/ limit cp-src/Range.h /^ double limit (void) const { return rng_limit; }$/ @@ -3462,7 +3414,6 @@ loadPORManager php-src/lce_functions.php /^ function &loadPORManager()$/ local_if_set c-src/emacs/src/lisp.h 2338 location cp-src/clheir.hpp 33 location cp-src/clheir.hpp /^ location() { }$/ -lookup cccp.y /^lookup (name, len, hash)$/ lookup y-src/cccp.y /^lookup (name, len, hash)$/ lowcase c-src/etags.c /^#define lowcase(c) tolower (CHAR (c))$/ lucid_event_type_list_p c-src/emacs/src/keyboard.c /^lucid_event_type_list_p (Lisp_Object object)$/ @@ -3573,6 +3524,7 @@ my_struct c.c 226 my_struct c-src/h.h 91 my_typedef c.c 228 my_typedef c-src/h.h 93 +mypi forth-src/test-forth.fth /^synonym mypi fconst$/ n c-src/exit.c 28 n c-src/exit.strange_suffix 28 name c-src/getopt.h 76 @@ -3601,9 +3553,6 @@ name tex-src/texinfo.tex /^\\begingroup\\defname {#1}{User Option}%$/ name tex-src/texinfo.tex /^\\begingroup\\defname {\\code{#1} #2}{Variable}%$/ name tex-src/texinfo.tex /^\\begingroup\\defname {\\code{#2} #3}{#1}$/ name tex-src/texinfo.tex /^\\begingroup\\defname {#2}{#1}\\deftpargs{#3}\\endgrou/ -name cccp.y 43 -name cccp.y 114 -name cccp.y 114 name y-src/cccp.y 43 name y-src/cccp.y 113 name y-src/cccp.y 113 @@ -3630,7 +3579,6 @@ next c-src/emacs/src/lisp.h 1848 next c-src/emacs/src/lisp.h 2192 next c-src/emacs/src/lisp.h 3028 next c-src/emacs/src/lisp.h 3134 -next cccp.y 42 next y-src/cccp.y 42 next-file el-src/emacs/lisp/progmodes/etags.el /^(defun next-file (&optional initialize novisit)$/ next-file-list el-src/emacs/lisp/progmodes/etags.el /^(defvar next-file-list nil$/ @@ -3704,9 +3652,7 @@ object_registry cp-src/clheir.cpp 10 objtag c-src/etags.c 2453 objvar c-src/emacs/src/lisp.h 2297 obstack_chunk_alloc y-src/parse.y 46 -obstack_chunk_alloc parse.y 46 obstack_chunk_free y-src/parse.y 47 -obstack_chunk_free parse.y 47 ocatseen c-src/etags.c 2477 octave_MDiagArray2_h cp-src/MDiagArray2.h 29 octave_Range_h cp-src/Range.h 24 @@ -3729,7 +3675,6 @@ open objc-src/PackInsp.m /^-open:sender$/ open-dribble-file c-src/emacs/src/keyboard.c /^DEFUN ("open-dribble-file", Fopen_dribble_file, So/ openInWorkspace objc-src/PackInsp.m /^static void openInWorkspace(const char *filename)$/ operationKeys objcpp-src/SimpleCalc.M /^- operationKeys:sender$/ -operator cccp.y 438 operator y-src/cccp.y 438 operator ++ cp-src/functions.cpp /^Date & Date::operator ++ ( void ){$/ operator += cp-src/functions.cpp /^Date & Date::operator += ( int days ){$/ @@ -3784,6 +3729,8 @@ outputtable html-src/algrthms.html /^Output$/ outsyn prol-src/natded.prolog /^outsyn(['Any'],_).$/ p c-src/emacs/src/lisp.h 4673 p c-src/emacs/src/lisp.h 4679 +p.x forth-src/test-forth.fth /^ 1 CELLS +FIELD p.x \\ A single cell filed name/ +p.y forth-src/test-forth.fth /^ 1 CELLS +FIELD p.y \\ A single cell field name/ p/f ada-src/etags-test-for.ada /^ function p pragma Import (C,$/ p/f ada-src/etags-test-for.ada /^function p ("p");$/ pD c-src/emacs/src/lisp.h 165 @@ -3803,23 +3750,16 @@ parent c-src/emacs/src/keyboard.c 8745 parent c-src/emacs/src/lisp.h 1590 parse prol-src/natded.prolog /^parse(Ws,Cat):-$/ parseFromVars php-src/lce_functions.php /^ function parseFromVars($prefix)$/ -parse_c_expression cccp.y /^parse_c_expression (string)$/ parse_c_expression y-src/cccp.y /^parse_c_expression (string)$/ parse_cgi prol-src/natded.prolog /^parse_cgi(TokenList,KeyVals):-$/ parse_error y-src/parse.y 81 -parse_error parse.y 81 -parse_escape cccp.y /^parse_escape (string_ptr)$/ parse_escape y-src/cccp.y /^parse_escape (string_ptr)$/ parse_hash y-src/parse.y 63 -parse_hash parse.y 63 parse_menu_item c-src/emacs/src/keyboard.c /^parse_menu_item (Lisp_Object item, int inmenubar)$/ parse_modifiers c-src/emacs/src/keyboard.c /^parse_modifiers (Lisp_Object symbol)$/ parse_modifiers_uncached c-src/emacs/src/keyboard.c /^parse_modifiers_uncached (Lisp_Object symbol, ptrd/ -parse_number cccp.y /^parse_number (olen)$/ parse_number y-src/cccp.y /^parse_number (olen)$/ parse_return y-src/parse.y 73 -parse_return parse.y 73 -parse_return_error cccp.y 70 parse_return_error y-src/cccp.y 70 parse_solitary_modifier c-src/emacs/src/keyboard.c /^parse_solitary_modifier (Lisp_Object symbol)$/ parse_tool_bar_item c-src/emacs/src/keyboard.c /^parse_tool_bar_item (Lisp_Object key, Lisp_Object / @@ -3839,6 +3779,7 @@ plist c-src/emacs/src/lisp.h 697 plus cp-src/functions.cpp /^void Date::plus ( int days , int month , int year / plus go-src/test1.go 5 plusvalseq prol-src/natded.prolog /^plusvalseq([]) --> [].$/ +point forth-src/test-forth.fth /^BEGIN-STRUCTURE point \\ create the named structure/ pointer c-src/emacs/src/lisp.h 2125 poll_for_input c-src/emacs/src/keyboard.c /^poll_for_input (struct atimer *timer)$/ poll_for_input_1 c-src/emacs/src/keyboard.c /^poll_for_input_1 (void)$/ @@ -3852,7 +3793,6 @@ position_to_Time c-src/emacs/src/keyboard.c /^position_to_Time (ptrdiff_t pos)$/ posix_memalign c-src/emacs/src/gmalloc.c /^posix_memalign (void **memptr, size_t alignment, s/ posn-at-point c-src/emacs/src/keyboard.c /^DEFUN ("posn-at-point", Fposn_at_point, Sposn_at_p/ posn-at-x-y c-src/emacs/src/keyboard.c /^DEFUN ("posn-at-x-y", Fposn_at_x_y, Sposn_at_x_y, / -possible_sum_sign cccp.y /^#define possible_sum_sign(a, b, sum) ((((a) ^ (b))/ possible_sum_sign y-src/cccp.y /^#define possible_sum_sign(a, b, sum) ((((a) ^ (b))/ post pyt-src/server.py /^ def post(self):$/ post pyt-src/server.py /^ def post(self):$/ @@ -4020,7 +3960,6 @@ return_to_command_loop c-src/emacs/src/keyboard.c 135 reverse prol-src/natded.prolog /^reverse([],Ws,Ws).$/ revert objc-src/PackInsp.m /^-revert:sender$/ right c-src/etags.c 216 -right_shift cccp.y /^right_shift (a, b)$/ right_shift y-src/cccp.y /^right_shift (a, b)$/ ring1 c.c 241 ring2 c.c 242 @@ -4218,7 +4157,6 @@ suffix c-src/etags.c 186 suffixes c-src/etags.c 195 suggest_asking_for_help c-src/etags.c /^suggest_asking_for_help (void)$/ suspend-emacs c-src/emacs/src/keyboard.c /^DEFUN ("suspend-emacs", Fsuspend_emacs, Ssuspend_e/ -sval cccp.y 117 sval y-src/cccp.y 116 swallow_events c-src/emacs/src/keyboard.c /^swallow_events (bool do_display)$/ switch_line_buffers c-src/etags.c /^#define switch_line_buffers() (curndx = 1 - curndx/ @@ -4371,13 +4309,10 @@ toc_line perl-src/htlmify-cystic /^sub toc_line ($)$/ toggleDescription objc-src/PackInsp.m /^-toggleDescription$/ tok c-src/etags.c 2491 token c-src/etags.c 2508 -token cccp.y 437 -token cccp.y 439 token y-src/cccp.y 437 token y-src/cccp.y 439 tokenize prol-src/natded.prolog /^tokenize([C1,C2,C3|Cs],Xs-Ys,TsResult):- % spe/ tokenizeatom prol-src/natded.prolog /^tokenizeatom(Atom,Ws):-$/ -tokentab2 cccp.y 442 tokentab2 y-src/cccp.y 442 tool_bar_item_properties c-src/emacs/src/keyboard.c 7970 tool_bar_items c-src/emacs/src/keyboard.c /^tool_bar_items (Lisp_Object reuse, int *nitems)$/ @@ -4436,7 +4371,6 @@ unblock_input_to c-src/emacs/src/keyboard.c /^unblock_input_to (int level)$/ unchar c-src/h.h 99 unexpand-abbrev c-src/abbrev.c /^DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexp/ unread_switch_frame c-src/emacs/src/keyboard.c 204 -unsignedp cccp.y 113 unsignedp y-src/cccp.y 112 uprintmax_t c-src/emacs/src/lisp.h 149 uprintmax_t c-src/emacs/src/lisp.h 154 @@ -4462,7 +4396,6 @@ validate php-src/lce_functions.php /^ function validate($value)$/ valloc c-src/emacs/src/gmalloc.c /^valloc (size_t size)$/ valseq prol-src/natded.prolog /^valseq([Val|Vals]) --> val(Val), plusvalseq(Vals)./ value c-src/emacs/src/lisp.h 687 -value cccp.y 113 value y-src/cccp.y 112 var c-src/emacs/src/keyboard.c 11023 var c-src/emacs/src/lisp.h 3137 @@ -4480,11 +4413,9 @@ visit-tags-table el-src/emacs/lisp/progmodes/etags.el /^(defun visit-tags-table visit-tags-table-buffer el-src/emacs/lisp/progmodes/etags.el /^(defun visit-tags-table-buffer (&optional cont)$/ void c-src/emacs/src/lisp.h /^INLINE void (check_cons_list) (void) { lisp_h_chec/ voidfuncptr c-src/emacs/src/lisp.h 2108 -voidval cccp.y 116 voidval y-src/cccp.y 115 wait_status_ptr_t c.c 161 waiting_for_input c-src/emacs/src/keyboard.c 150 -warning cccp.y /^warning (msg)$/ warning y-src/cccp.y /^warning (msg)$/ weak c-src/emacs/src/lisp.h 1830 weak_alias c-src/emacs/src/gmalloc.c /^weak_alias (free, cfree)$/ @@ -4550,34 +4481,21 @@ y cp-src/clheir.hpp 58 y-get-selection-internal c.c /^ Fy_get_selection_internal, Sy_get_selection_/ yyalloc /usr/share/bison/bison.simple 83 yyalloc /usr/share/bison/bison.simple 84 -yycheck parse.y 330 -yycheck cccp.y 301 yyclearin /usr/share/bison/bison.simple 149 yyclearin /usr/share/bison/bison.simple 150 yydebug /usr/share/bison/bison.simple 237 yydebug /usr/share/bison/bison.simple 238 -yydefact parse.y 219 -yydefact cccp.y 239 -yydefgoto parse.y 237 -yydefgoto cccp.y 251 yyerrhandle /usr/share/bison/bison.simple 848 -yyerrhandle /usr/share/bison/bison.simple 848 -yyerrlab1 /usr/share/bison/bison.simple 823 yyerrlab1 /usr/share/bison/bison.simple 823 yyerrok /usr/share/bison/bison.simple 148 yyerrok /usr/share/bison/bison.simple 149 -yyerror cccp.y /^yyerror (s)$/ yyerror y-src/cccp.y /^yyerror (s)$/ yyerrstatus /usr/share/bison/bison.simple 846 -yyerrstatus /usr/share/bison/bison.simple 846 -yylex cccp.y /^yylex ()$/ yylex y-src/cccp.y /^yylex ()$/ yyls /usr/share/bison/bison.simple 88 yyls /usr/share/bison/bison.simple 89 yylsp /usr/share/bison/bison.simple 748 yylsp /usr/share/bison/bison.simple 921 -yylsp /usr/share/bison/bison.simple 748 -yylsp /usr/share/bison/bison.simple 921 yymemcpy /usr/share/bison/bison.simple 264 yymemcpy /usr/share/bison/bison.simple /^yymemcpy (char *yyto, const char *yyfrom, YYSIZE_T/ yymemcpy /usr/share/bison/bison.simple 265 @@ -4586,50 +4504,21 @@ yyn /usr/share/bison/bison.simple 755 yyn /usr/share/bison/bison.simple 861 yyn /usr/share/bison/bison.simple 895 yyn /usr/share/bison/bison.simple 903 -yyn /usr/share/bison/bison.simple 755 -yyn /usr/share/bison/bison.simple 861 -yyn /usr/share/bison/bison.simple 895 -yyn /usr/share/bison/bison.simple 903 -yynewstate /usr/share/bison/bison.simple 763 -yynewstate /usr/share/bison/bison.simple 925 yynewstate /usr/share/bison/bison.simple 763 yynewstate /usr/share/bison/bison.simple 925 -yypact parse.y 242 -yypact cccp.y 256 yyparse /usr/share/bison/bison.simple /^yyparse (YYPARSE_PARAM_ARG)$/ yyparse /usr/share/bison/bison.simple /^yyparse (YYPARSE_PARAM_ARG)$/ -yypgoto parse.y 260 -yypgoto cccp.y 268 -yyprhs parse.y 134 -yyprhs cccp.y 167 -yyr1 parse.y 197 -yyr1 cccp.y 219 -yyr2 parse.y 207 -yyr2 cccp.y 228 -yyresult /usr/share/bison/bison.simple 932 -yyresult /usr/share/bison/bison.simple 939 -yyresult /usr/share/bison/bison.simple 947 yyresult /usr/share/bison/bison.simple 932 yyresult /usr/share/bison/bison.simple 939 yyresult /usr/share/bison/bison.simple 947 yyreturn /usr/share/bison/bison.simple 933 yyreturn /usr/share/bison/bison.simple 940 -yyreturn /usr/share/bison/bison.simple 933 -yyreturn /usr/share/bison/bison.simple 940 -yyrhs parse.y 142 -yyrhs cccp.y 174 -yyrline parse.y 171 -yyrline cccp.y 195 yyss /usr/share/bison/bison.simple 85 yyss /usr/share/bison/bison.simple 86 yystate /usr/share/bison/bison.simple 757 yystate /usr/share/bison/bison.simple 761 yystate /usr/share/bison/bison.simple 875 yystate /usr/share/bison/bison.simple 924 -yystate /usr/share/bison/bison.simple 757 -yystate /usr/share/bison/bison.simple 761 -yystate /usr/share/bison/bison.simple 875 -yystate /usr/share/bison/bison.simple 924 yystpcpy /usr/share/bison/bison.simple 316 yystpcpy /usr/share/bison/bison.simple /^yystpcpy (char *yydest, const char *yysrc)$/ yystpcpy /usr/share/bison/bison.simple 317 @@ -4638,19 +4527,10 @@ yystrlen /usr/share/bison/bison.simple 293 yystrlen /usr/share/bison/bison.simple /^yystrlen (const char *yystr)$/ yystrlen /usr/share/bison/bison.simple 294 yystrlen /usr/share/bison/bison.simple /^yystrlen (const char *yystr)$/ -yystype cccp.y 118 -yytable parse.y 269 -yytable cccp.y 277 -yytname parse.y 185 -yytname cccp.y 208 -yytranslate parse.y 101 -yytranslate cccp.y 135 yyvs /usr/share/bison/bison.simple 86 yyvs /usr/share/bison/bison.simple 87 yyvsp /usr/share/bison/bison.simple 746 yyvsp /usr/share/bison/bison.simple 919 -yyvsp /usr/share/bison/bison.simple 746 -yyvsp /usr/share/bison/bison.simple 919 z c.c 144 z c.c 164 z cp-src/clheir.hpp 49 diff --git a/test/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1 index 873914474e2..b3bd2410fcc 100644 --- a/test/etags/ETAGS.good_1 +++ b/test/manual/etags/ETAGS.good_1 @@ -2311,19 +2311,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 @@ -4006,49 +4019,7 @@ y-src/parse.c,520 # define L_NE 26,492 # define L_GE 27,510 -parse.y,1181 -#define obstack_chunk_alloc 46, -#define obstack_chunk_free 47, -VOIDSTAR parse_hash;63, -unsigned char fnin[fnin67, -#define YYSTYPE 71, -typedef struct node *YYSTYPE;YYSTYPE72, -YYSTYPE parse_return;73, -char *instr;instr80, -int parse_error 81, -#define YYSTYPE 85, -# define YYDEBUG 88, -#define YYFINAL 93, -#define YYFLAG 94, -#define YYNTBASE 95, -#define YYTRANSLATE(98, -static const char yytranslate[yytranslate101, -static const short yyprhs[yyprhs134, -static const short yyrhs[yyrhs142, -static const short yyrline[yyrline171, -static const char *const yytname[yytname185, -static const short yyr1[yyr1197, -static const short yyr2[yyr2207, -static const short yydefact[yydefact219, -static const short yydefgoto[yydefgoto237, -static const short yypact[yypact242, -static const short yypgoto[yypgoto260, -#define YYLAST 266, -static const short yytable[yytable269, -static const short yycheck[yycheck330, -yyerror FUN1(285, -make_list FUN2(292, -#define ERROR 303, -yylex FUN0(314, -parse_cell_or_range FUN2(586, -#define CK_ABS_R(670, -#define CK_REL_R(674, -#define CK_ABS_C(679, -#define CK_REL_C(683, -#define MAYBEREL(688, -str_to_col FUN1(846, - -/usr/share/bison/bison.simple,2110 +/usr/share/bison/bison.simple,1693 # define YYSTD(40, # define YYSTD(42, # define YYSTACK_ALLOC 50, @@ -4115,28 +4086,6 @@ yyparse 403, # define YYPOPSTACK 445, # define YYPOPSTACK 447, # undef YYSTACK_RELOCATE548, - *++yyvsp yyvsp746, - *++yylsp yylsp748, - yyn 755, - yystate 757, - yystate 761, - goto yynewstate;763, - goto yyerrlab1;823, - yyerrstatus 846, - goto yyerrhandle;848, - yyn 861, - yystate 875, - yyn 895, - yyn 903, - *++yyvsp yyvsp919, - *++yylsp yylsp921, - yystate 924, - goto yynewstate;925, - yyresult 932, - goto yyreturn;933, - yyresult 939, - goto yyreturn;940, - yyresult 947, y-src/atest.y,9 exp 2,3 @@ -4157,64 +4106,6 @@ y-src/cccp.c,303 # define RSH 17,310 # define UNARY 18,327 -cccp.y,1579 -typedef unsigned char U_CHAR;38, -struct arglist 41, -#define NULL 51, -#define GENERIC_PTR 56, -#define GENERIC_PTR 58, -#define NULL_PTR 63, -int expression_value;68, -static jmp_buf parse_return_error;70, -static int keyword_parsing 73, -#define CHAR_TYPE_SIZE 87, -#define INT_TYPE_SIZE 91, -#define LONG_TYPE_SIZE 95, -#define WCHAR_TYPE_SIZE 99, -#define possible_sum_sign(104, - struct constant 113, - struct name 114, -} yystype;118, -# define YYSTYPE 119, -# define YYDEBUG 122, -#define YYFINAL 127, -#define YYFLAG 128, -#define YYNTBASE 129, -#define YYTRANSLATE(132, -static const char yytranslate[yytranslate135, -static const short yyprhs[yyprhs167, -static const short yyrhs[yyrhs174, -static const short yyrline[yyrline195, -static const char *const yytname[yytname208, -static const short yyr1[yyr1219, -static const short yyr2[yyr2228, -static const short yydefact[yydefact239, -static const short yydefgoto[yydefgoto251, -static const short yypact[yypact256, -static const short yypgoto[yypgoto268, -#define YYLAST 274, -static const short yytable[yytable277, -static const short yycheck[yycheck301, -static char *lexptr;lexptr332, -parse_number 341, -struct token 437, -static struct token tokentab2[tokentab2442, -yylex 459, -parse_escape 740, -yyerror 836, -integer_overflow 844, -left_shift 851, -right_shift 873, -parse_c_expression 893, -main 923, -unsigned char is_idchar[is_idchar948, -unsigned char is_idstart[is_idstart950, -char is_hor_space[is_hor_space953, -initialize_random_junk 958, -error 988, -warning 993, -lookup 999, - /usr/share/bison/bison.simple,2110 # define YYSTD(41, # define YYSTD(43, diff --git a/test/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2 index 7f24d06432c..170d8457d19 100644 --- a/test/etags/ETAGS.good_2 +++ b/test/manual/etags/ETAGS.good_2 @@ -2880,19 +2880,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 @@ -4593,59 +4606,7 @@ y-src/parse.c,520 # define L_NE 26,492 # define L_GE 27,510 -parse.y,1464 -#define obstack_chunk_alloc 46, -#define obstack_chunk_free 47, -int yylex 57, -void yyerror 59, -void yyerror 61, -VOIDSTAR parse_hash;63, -extern VOIDSTAR hash_find(64, -unsigned char fnin[fnin67, -#define YYSTYPE 71, -typedef struct node *YYSTYPE;YYSTYPE72, -YYSTYPE parse_return;73, -YYSTYPE make_list 75, -YYSTYPE make_list 77, -char *instr;instr80, -int parse_error 81, -extern struct obstack tmp_mem;82, -#define YYSTYPE 85, -# define YYDEBUG 88, -#define YYFINAL 93, -#define YYFLAG 94, -#define YYNTBASE 95, -#define YYTRANSLATE(98, -static const char yytranslate[yytranslate101, -static const short yyprhs[yyprhs134, -static const short yyrhs[yyrhs142, -static const short yyrline[yyrline171, -static const char *const yytname[yytname185, -static const short yyr1[yyr1197, -static const short yyr2[yyr2207, -static const short yydefact[yydefact219, -static const short yydefgoto[yydefgoto237, -static const short yypact[yypact242, -static const short yypgoto[yypgoto260, -#define YYLAST 266, -static const short yytable[yytable269, -static const short yycheck[yycheck330, -yyerror FUN1(285, -make_list FUN2(292, -#define ERROR 303, -extern struct node *yylval;yylval305, -unsigned char parse_cell_or_range 308, -unsigned char parse_cell_or_range 310, -yylex FUN0(314, -parse_cell_or_range FUN2(586, -#define CK_ABS_R(670, -#define CK_REL_R(674, -#define CK_ABS_C(679, -#define CK_REL_C(683, -#define MAYBEREL(688, -str_to_col FUN1(846, - -/usr/share/bison/bison.simple,2180 +/usr/share/bison/bison.simple,1729 # define YYSTD(40, # define YYSTD(42, # define YYSTACK_ALLOC 50, @@ -4714,30 +4675,6 @@ yyparse 403, # define YYPOPSTACK 445, # define YYPOPSTACK 447, # undef YYSTACK_RELOCATE548, - *++yyvsp yyvsp746, - *++yylsp yylsp748, - yyn 755, - yystate 757, - yystate 761, - goto yynewstate;763, - goto yyerrlab1;823, - yyerrstatus 846, - goto yyerrhandle;848, - yyn 861, - yystate 875, - yyn 895, - yyn 903, - YYDPRINTF 917, - *++yyvsp yyvsp919, - *++yylsp yylsp921, - yystate 924, - goto yynewstate;925, - yyresult 932, - goto yyreturn;933, - yyresult 939, - goto yyreturn;940, - yyerror 946, - yyresult 947, y-src/atest.y,9 exp 2,3 @@ -4758,76 +4695,6 @@ y-src/cccp.c,303 # define RSH 17,310 # define UNARY 18,327 -cccp.y,2005 -typedef unsigned char U_CHAR;38, -struct arglist 41, -#define NULL 51, -#define GENERIC_PTR 56, -#define GENERIC_PTR 58, -#define NULL_PTR 63, -int yylex 66, -void yyerror 67, -int expression_value;68, -static jmp_buf parse_return_error;70, -static int keyword_parsing 73, -extern unsigned char is_idstart[is_idstart76, -extern unsigned char is_idstart[], is_idchar[is_idchar76, -extern unsigned char is_idstart[], is_idchar[], is_hor_space[is_hor_space76, -extern char *xmalloc xmalloc78, -extern int pedantic;81, -extern int traditional;84, -#define CHAR_TYPE_SIZE 87, -#define INT_TYPE_SIZE 91, -#define LONG_TYPE_SIZE 95, -#define WCHAR_TYPE_SIZE 99, -#define possible_sum_sign(104, -static void integer_overflow 106, -static long left_shift 107, -static long right_shift 108, - struct constant 113, - struct name 114, -} yystype;118, -# define YYSTYPE 119, -# define YYDEBUG 122, -#define YYFINAL 127, -#define YYFLAG 128, -#define YYNTBASE 129, -#define YYTRANSLATE(132, -static const char yytranslate[yytranslate135, -static const short yyprhs[yyprhs167, -static const short yyrhs[yyrhs174, -static const short yyrline[yyrline195, -static const char *const yytname[yytname208, -static const short yyr1[yyr1219, -static const short yyr2[yyr2228, -static const short yydefact[yydefact239, -static const short yydefgoto[yydefgoto251, -static const short yypact[yypact256, -static const short yypgoto[yypgoto268, -#define YYLAST 274, -static const short yytable[yytable277, -static const short yycheck[yycheck301, -static char *lexptr;lexptr332, -parse_number 341, -struct token 437, -static struct token tokentab2[tokentab2442, -yylex 459, -parse_escape 740, -yyerror 836, -integer_overflow 844, -left_shift 851, -right_shift 873, -parse_c_expression 893, -extern int yydebug;919, -main 923, -unsigned char is_idchar[is_idchar948, -unsigned char is_idstart[is_idstart950, -char is_hor_space[is_hor_space953, -initialize_random_junk 958, -error 988, -warning 993, -lookup 999, - /usr/share/bison/bison.simple,2180 # define YYSTD(41, # define YYSTD(43, diff --git a/test/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3 index f8bd93330e2..1d75314a37f 100644 --- a/test/etags/ETAGS.good_3 +++ b/test/manual/etags/ETAGS.good_3 @@ -2628,19 +2628,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 @@ -4368,49 +4381,7 @@ y-src/parse.c,520 # define L_NE 26,492 # define L_GE 27,510 -parse.y,1181 -#define obstack_chunk_alloc 46, -#define obstack_chunk_free 47, -VOIDSTAR parse_hash;63, -unsigned char fnin[fnin67, -#define YYSTYPE 71, -typedef struct node *YYSTYPE;YYSTYPE72, -YYSTYPE parse_return;73, -char *instr;instr80, -int parse_error 81, -#define YYSTYPE 85, -# define YYDEBUG 88, -#define YYFINAL 93, -#define YYFLAG 94, -#define YYNTBASE 95, -#define YYTRANSLATE(98, -static const char yytranslate[yytranslate101, -static const short yyprhs[yyprhs134, -static const short yyrhs[yyrhs142, -static const short yyrline[yyrline171, -static const char *const yytname[yytname185, -static const short yyr1[yyr1197, -static const short yyr2[yyr2207, -static const short yydefact[yydefact219, -static const short yydefgoto[yydefgoto237, -static const short yypact[yypact242, -static const short yypgoto[yypgoto260, -#define YYLAST 266, -static const short yytable[yytable269, -static const short yycheck[yycheck330, -yyerror FUN1(285, -make_list FUN2(292, -#define ERROR 303, -yylex FUN0(314, -parse_cell_or_range FUN2(586, -#define CK_ABS_R(670, -#define CK_REL_R(674, -#define CK_ABS_C(679, -#define CK_REL_C(683, -#define MAYBEREL(688, -str_to_col FUN1(846, - -/usr/share/bison/bison.simple,2168 +/usr/share/bison/bison.simple,1751 # define YYSTD(40, # define YYSTD(42, # define YYSTACK_ALLOC 50, @@ -4480,28 +4451,6 @@ yyparse 403, # define YYPOPSTACK 445, # define YYPOPSTACK 447, # undef YYSTACK_RELOCATE548, - *++yyvsp yyvsp746, - *++yylsp yylsp748, - yyn 755, - yystate 757, - yystate 761, - goto yynewstate;763, - goto yyerrlab1;823, - yyerrstatus 846, - goto yyerrhandle;848, - yyn 861, - yystate 875, - yyn 895, - yyn 903, - *++yyvsp yyvsp919, - *++yylsp yylsp921, - yystate 924, - goto yynewstate;925, - yyresult 932, - goto yyreturn;933, - yyresult 939, - goto yyreturn;940, - yyresult 947, y-src/atest.y,9 exp 2,3 @@ -4522,79 +4471,6 @@ y-src/cccp.c,303 # define RSH 17,310 # define UNARY 18,327 -cccp.y,2106 -typedef unsigned char U_CHAR;38, -struct arglist 41, - struct arglist *next;next42, - U_CHAR *name;name43, - int length;44, - int argno;45, -#define NULL 51, -#define GENERIC_PTR 56, -#define GENERIC_PTR 58, -#define NULL_PTR 63, -int expression_value;68, -static jmp_buf parse_return_error;70, -static int keyword_parsing 73, -#define CHAR_TYPE_SIZE 87, -#define INT_TYPE_SIZE 91, -#define LONG_TYPE_SIZE 95, -#define WCHAR_TYPE_SIZE 99, -#define possible_sum_sign(104, - struct constant 113, - struct constant {long value;113, - struct constant {long value; int unsignedp;113, - struct constant {long value; int unsignedp;} integer;113, - struct name 114, - struct name {U_CHAR *address;address114, - struct name {U_CHAR *address; int length;114, - struct name {U_CHAR *address; int length;} name;114, - struct arglist *keywords;keywords115, - int voidval;116, - char *sval;sval117, -} yystype;118, -# define YYSTYPE 119, -# define YYDEBUG 122, -#define YYFINAL 127, -#define YYFLAG 128, -#define YYNTBASE 129, -#define YYTRANSLATE(132, -static const char yytranslate[yytranslate135, -static const short yyprhs[yyprhs167, -static const short yyrhs[yyrhs174, -static const short yyrline[yyrline195, -static const char *const yytname[yytname208, -static const short yyr1[yyr1219, -static const short yyr2[yyr2228, -static const short yydefact[yydefact239, -static const short yydefgoto[yydefgoto251, -static const short yypact[yypact256, -static const short yypgoto[yypgoto268, -#define YYLAST 274, -static const short yytable[yytable277, -static const short yycheck[yycheck301, -static char *lexptr;lexptr332, -parse_number 341, -struct token 437, - char *operator;operator438, - int token;439, -static struct token tokentab2[tokentab2442, -yylex 459, -parse_escape 740, -yyerror 836, -integer_overflow 844, -left_shift 851, -right_shift 873, -parse_c_expression 893, -main 923, -unsigned char is_idchar[is_idchar948, -unsigned char is_idstart[is_idstart950, -char is_hor_space[is_hor_space953, -initialize_random_junk 958, -error 988, -warning 993, -lookup 999, - /usr/share/bison/bison.simple,2168 # define YYSTD(41, # define YYSTD(43, diff --git a/test/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4 index 9db5e3833a2..e74db284274 100644 --- a/test/etags/ETAGS.good_4 +++ b/test/manual/etags/ETAGS.good_4 @@ -2475,19 +2475,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 @@ -4170,49 +4183,7 @@ y-src/parse.c,520 # define L_NE 26,492 # define L_GE 27,510 -parse.y,1181 -#define obstack_chunk_alloc 46, -#define obstack_chunk_free 47, -VOIDSTAR parse_hash;63, -unsigned char fnin[fnin67, -#define YYSTYPE 71, -typedef struct node *YYSTYPE;YYSTYPE72, -YYSTYPE parse_return;73, -char *instr;instr80, -int parse_error 81, -#define YYSTYPE 85, -# define YYDEBUG 88, -#define YYFINAL 93, -#define YYFLAG 94, -#define YYNTBASE 95, -#define YYTRANSLATE(98, -static const char yytranslate[yytranslate101, -static const short yyprhs[yyprhs134, -static const short yyrhs[yyrhs142, -static const short yyrline[yyrline171, -static const char *const yytname[yytname185, -static const short yyr1[yyr1197, -static const short yyr2[yyr2207, -static const short yydefact[yydefact219, -static const short yydefgoto[yydefgoto237, -static const short yypact[yypact242, -static const short yypgoto[yypgoto260, -#define YYLAST 266, -static const short yytable[yytable269, -static const short yycheck[yycheck330, -yyerror FUN1(285, -make_list FUN2(292, -#define ERROR 303, -yylex FUN0(314, -parse_cell_or_range FUN2(586, -#define CK_ABS_R(670, -#define CK_REL_R(674, -#define CK_ABS_C(679, -#define CK_REL_C(683, -#define MAYBEREL(688, -str_to_col FUN1(846, - -/usr/share/bison/bison.simple,2110 +/usr/share/bison/bison.simple,1693 # define YYSTD(40, # define YYSTD(42, # define YYSTACK_ALLOC 50, @@ -4279,28 +4250,6 @@ yyparse 403, # define YYPOPSTACK 445, # define YYPOPSTACK 447, # undef YYSTACK_RELOCATE548, - *++yyvsp yyvsp746, - *++yylsp yylsp748, - yyn 755, - yystate 757, - yystate 761, - goto yynewstate;763, - goto yyerrlab1;823, - yyerrstatus 846, - goto yyerrhandle;848, - yyn 861, - yystate 875, - yyn 895, - yyn 903, - *++yyvsp yyvsp919, - *++yylsp yylsp921, - yystate 924, - goto yynewstate;925, - yyresult 932, - goto yyreturn;933, - yyresult 939, - goto yyreturn;940, - yyresult 947, y-src/atest.y,9 exp 2,3 @@ -4321,64 +4270,6 @@ y-src/cccp.c,303 # define RSH 17,310 # define UNARY 18,327 -cccp.y,1579 -typedef unsigned char U_CHAR;38, -struct arglist 41, -#define NULL 51, -#define GENERIC_PTR 56, -#define GENERIC_PTR 58, -#define NULL_PTR 63, -int expression_value;68, -static jmp_buf parse_return_error;70, -static int keyword_parsing 73, -#define CHAR_TYPE_SIZE 87, -#define INT_TYPE_SIZE 91, -#define LONG_TYPE_SIZE 95, -#define WCHAR_TYPE_SIZE 99, -#define possible_sum_sign(104, - struct constant 113, - struct name 114, -} yystype;118, -# define YYSTYPE 119, -# define YYDEBUG 122, -#define YYFINAL 127, -#define YYFLAG 128, -#define YYNTBASE 129, -#define YYTRANSLATE(132, -static const char yytranslate[yytranslate135, -static const short yyprhs[yyprhs167, -static const short yyrhs[yyrhs174, -static const short yyrline[yyrline195, -static const char *const yytname[yytname208, -static const short yyr1[yyr1219, -static const short yyr2[yyr2228, -static const short yydefact[yydefact239, -static const short yydefgoto[yydefgoto251, -static const short yypact[yypact256, -static const short yypgoto[yypgoto268, -#define YYLAST 274, -static const short yytable[yytable277, -static const short yycheck[yycheck301, -static char *lexptr;lexptr332, -parse_number 341, -struct token 437, -static struct token tokentab2[tokentab2442, -yylex 459, -parse_escape 740, -yyerror 836, -integer_overflow 844, -left_shift 851, -right_shift 873, -parse_c_expression 893, -main 923, -unsigned char is_idchar[is_idchar948, -unsigned char is_idstart[is_idstart950, -char is_hor_space[is_hor_space953, -initialize_random_junk 958, -error 988, -warning 993, -lookup 999, - /usr/share/bison/bison.simple,2110 # define YYSTD(41, # define YYSTD(43, diff --git a/test/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5 index 982682d0102..e278678b547 100644 --- a/test/etags/ETAGS.good_5 +++ b/test/manual/etags/ETAGS.good_5 @@ -3361,19 +3361,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 @@ -5119,59 +5132,7 @@ y-src/parse.c,520 # define L_NE 26,492 # define L_GE 27,510 -parse.y,1464 -#define obstack_chunk_alloc 46, -#define obstack_chunk_free 47, -int yylex 57, -void yyerror 59, -void yyerror 61, -VOIDSTAR parse_hash;63, -extern VOIDSTAR hash_find(64, -unsigned char fnin[fnin67, -#define YYSTYPE 71, -typedef struct node *YYSTYPE;YYSTYPE72, -YYSTYPE parse_return;73, -YYSTYPE make_list 75, -YYSTYPE make_list 77, -char *instr;instr80, -int parse_error 81, -extern struct obstack tmp_mem;82, -#define YYSTYPE 85, -# define YYDEBUG 88, -#define YYFINAL 93, -#define YYFLAG 94, -#define YYNTBASE 95, -#define YYTRANSLATE(98, -static const char yytranslate[yytranslate101, -static const short yyprhs[yyprhs134, -static const short yyrhs[yyrhs142, -static const short yyrline[yyrline171, -static const char *const yytname[yytname185, -static const short yyr1[yyr1197, -static const short yyr2[yyr2207, -static const short yydefact[yydefact219, -static const short yydefgoto[yydefgoto237, -static const short yypact[yypact242, -static const short yypgoto[yypgoto260, -#define YYLAST 266, -static const short yytable[yytable269, -static const short yycheck[yycheck330, -yyerror FUN1(285, -make_list FUN2(292, -#define ERROR 303, -extern struct node *yylval;yylval305, -unsigned char parse_cell_or_range 308, -unsigned char parse_cell_or_range 310, -yylex FUN0(314, -parse_cell_or_range FUN2(586, -#define CK_ABS_R(670, -#define CK_REL_R(674, -#define CK_ABS_C(679, -#define CK_REL_C(683, -#define MAYBEREL(688, -str_to_col FUN1(846, - -/usr/share/bison/bison.simple,2238 +/usr/share/bison/bison.simple,1787 # define YYSTD(40, # define YYSTD(42, # define YYSTACK_ALLOC 50, @@ -5243,30 +5204,6 @@ yyparse 403, # define YYPOPSTACK 445, # define YYPOPSTACK 447, # undef YYSTACK_RELOCATE548, - *++yyvsp yyvsp746, - *++yylsp yylsp748, - yyn 755, - yystate 757, - yystate 761, - goto yynewstate;763, - goto yyerrlab1;823, - yyerrstatus 846, - goto yyerrhandle;848, - yyn 861, - yystate 875, - yyn 895, - yyn 903, - YYDPRINTF 917, - *++yyvsp yyvsp919, - *++yylsp yylsp921, - yystate 924, - goto yynewstate;925, - yyresult 932, - goto yyreturn;933, - yyresult 939, - goto yyreturn;940, - yyerror 946, - yyresult 947, y-src/atest.y,9 exp 2,3 @@ -5287,91 +5224,6 @@ y-src/cccp.c,303 # define RSH 17,310 # define UNARY 18,327 -cccp.y,2532 -typedef unsigned char U_CHAR;38, -struct arglist 41, - struct arglist *next;next42, - U_CHAR *name;name43, - int length;44, - int argno;45, -#define NULL 51, -#define GENERIC_PTR 56, -#define GENERIC_PTR 58, -#define NULL_PTR 63, -int yylex 66, -void yyerror 67, -int expression_value;68, -static jmp_buf parse_return_error;70, -static int keyword_parsing 73, -extern unsigned char is_idstart[is_idstart76, -extern unsigned char is_idstart[], is_idchar[is_idchar76, -extern unsigned char is_idstart[], is_idchar[], is_hor_space[is_hor_space76, -extern char *xmalloc xmalloc78, -extern int pedantic;81, -extern int traditional;84, -#define CHAR_TYPE_SIZE 87, -#define INT_TYPE_SIZE 91, -#define LONG_TYPE_SIZE 95, -#define WCHAR_TYPE_SIZE 99, -#define possible_sum_sign(104, -static void integer_overflow 106, -static long left_shift 107, -static long right_shift 108, - struct constant 113, - struct constant {long value;113, - struct constant {long value; int unsignedp;113, - struct constant {long value; int unsignedp;} integer;113, - struct name 114, - struct name {U_CHAR *address;address114, - struct name {U_CHAR *address; int length;114, - struct name {U_CHAR *address; int length;} name;114, - struct arglist *keywords;keywords115, - int voidval;116, - char *sval;sval117, -} yystype;118, -# define YYSTYPE 119, -# define YYDEBUG 122, -#define YYFINAL 127, -#define YYFLAG 128, -#define YYNTBASE 129, -#define YYTRANSLATE(132, -static const char yytranslate[yytranslate135, -static const short yyprhs[yyprhs167, -static const short yyrhs[yyrhs174, -static const short yyrline[yyrline195, -static const char *const yytname[yytname208, -static const short yyr1[yyr1219, -static const short yyr2[yyr2228, -static const short yydefact[yydefact239, -static const short yydefgoto[yydefgoto251, -static const short yypact[yypact256, -static const short yypgoto[yypgoto268, -#define YYLAST 274, -static const short yytable[yytable277, -static const short yycheck[yycheck301, -static char *lexptr;lexptr332, -parse_number 341, -struct token 437, - char *operator;operator438, - int token;439, -static struct token tokentab2[tokentab2442, -yylex 459, -parse_escape 740, -yyerror 836, -integer_overflow 844, -left_shift 851, -right_shift 873, -parse_c_expression 893, -extern int yydebug;919, -main 923, -unsigned char is_idchar[is_idchar948, -unsigned char is_idstart[is_idstart950, -char is_hor_space[is_hor_space953, -initialize_random_junk 958, -error 988, -warning 993, -lookup 999, - /usr/share/bison/bison.simple,2238 # define YYSTD(41, # define YYSTD(43, diff --git a/test/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6 index cf402ae50d7..68e474d6285 100644 --- a/test/etags/ETAGS.good_6 +++ b/test/manual/etags/ETAGS.good_6 @@ -3361,19 +3361,32 @@ f-src/entry.strange,172 & intensity1(577,12231 character*(*) function foo(579,12307 -forth-src/test-forth.fth,408 -: a-forth-word 20,301 +forth-src/test-forth.fth,733 +: a-forth-word20,301 99 constant a-forth-constant!22,343 55 value a-forth-value?23,373 create :a-forth-dictionary-entry24,397 defer #a-defer-word27,460 -: (another-forth-word)(another-forth-word29,481 +: (another-forth-word)(another-forth-word)29,481 9 field >field136,582 5 field >field237,605 constant (a-forth-constant(a-forth-constant38,628 2000 buffer: #some-storage41,657 -code assemby-code-word 43,685 -: a-forth-word 50,870 +code assemby-code-word43,685 +: a-forth-word50,870 +: (foo)(foo)55,988 +: foo56,1000 +: create-bar58,1015 +3 4 2constant 2const61,1074 +2const 2value 2val62,1095 +2variable 2var63,1114 +3.1415e fconstant fconst65,1130 +fconst fvalue fval66,1155 +fvariable fvar67,1174 +synonym mypi69,1190 +BEGIN-STRUCTURE point71,1211 + 1 CELLS +FIELD p.x72,1262 + 1 CELLS +FIELD p.y73,1318 go-src/test.go,48 package main1,0 @@ -5119,59 +5132,7 @@ y-src/parse.c,520 # define L_NE 26,492 # define L_GE 27,510 -parse.y,1464 -#define obstack_chunk_alloc 46, -#define obstack_chunk_free 47, -int yylex 57, -void yyerror 59, -void yyerror 61, -VOIDSTAR parse_hash;63, -extern VOIDSTAR hash_find(64, -unsigned char fnin[fnin67, -#define YYSTYPE 71, -typedef struct node *YYSTYPE;YYSTYPE72, -YYSTYPE parse_return;73, -YYSTYPE make_list 75, -YYSTYPE make_list 77, -char *instr;instr80, -int parse_error 81, -extern struct obstack tmp_mem;82, -#define YYSTYPE 85, -# define YYDEBUG 88, -#define YYFINAL 93, -#define YYFLAG 94, -#define YYNTBASE 95, -#define YYTRANSLATE(98, -static const char yytranslate[yytranslate101, -static const short yyprhs[yyprhs134, -static const short yyrhs[yyrhs142, -static const short yyrline[yyrline171, -static const char *const yytname[yytname185, -static const short yyr1[yyr1197, -static const short yyr2[yyr2207, -static const short yydefact[yydefact219, -static const short yydefgoto[yydefgoto237, -static const short yypact[yypact242, -static const short yypgoto[yypgoto260, -#define YYLAST 266, -static const short yytable[yytable269, -static const short yycheck[yycheck330, -yyerror FUN1(285, -make_list FUN2(292, -#define ERROR 303, -extern struct node *yylval;yylval305, -unsigned char parse_cell_or_range 308, -unsigned char parse_cell_or_range 310, -yylex FUN0(314, -parse_cell_or_range FUN2(586, -#define CK_ABS_R(670, -#define CK_REL_R(674, -#define CK_ABS_C(679, -#define CK_REL_C(683, -#define MAYBEREL(688, -str_to_col FUN1(846, - -/usr/share/bison/bison.simple,2238 +/usr/share/bison/bison.simple,1787 # define YYSTD(40, # define YYSTD(42, # define YYSTACK_ALLOC 50, @@ -5243,30 +5204,6 @@ yyparse 403, # define YYPOPSTACK 445, # define YYPOPSTACK 447, # undef YYSTACK_RELOCATE548, - *++yyvsp yyvsp746, - *++yylsp yylsp748, - yyn 755, - yystate 757, - yystate 761, - goto yynewstate;763, - goto yyerrlab1;823, - yyerrstatus 846, - goto yyerrhandle;848, - yyn 861, - yystate 875, - yyn 895, - yyn 903, - YYDPRINTF 917, - *++yyvsp yyvsp919, - *++yylsp yylsp921, - yystate 924, - goto yynewstate;925, - yyresult 932, - goto yyreturn;933, - yyresult 939, - goto yyreturn;940, - yyerror 946, - yyresult 947, y-src/atest.y,9 exp 2,3 @@ -5287,91 +5224,6 @@ y-src/cccp.c,303 # define RSH 17,310 # define UNARY 18,327 -cccp.y,2532 -typedef unsigned char U_CHAR;38, -struct arglist 41, - struct arglist *next;next42, - U_CHAR *name;name43, - int length;44, - int argno;45, -#define NULL 51, -#define GENERIC_PTR 56, -#define GENERIC_PTR 58, -#define NULL_PTR 63, -int yylex 66, -void yyerror 67, -int expression_value;68, -static jmp_buf parse_return_error;70, -static int keyword_parsing 73, -extern unsigned char is_idstart[is_idstart76, -extern unsigned char is_idstart[], is_idchar[is_idchar76, -extern unsigned char is_idstart[], is_idchar[], is_hor_space[is_hor_space76, -extern char *xmalloc xmalloc78, -extern int pedantic;81, -extern int traditional;84, -#define CHAR_TYPE_SIZE 87, -#define INT_TYPE_SIZE 91, -#define LONG_TYPE_SIZE 95, -#define WCHAR_TYPE_SIZE 99, -#define possible_sum_sign(104, -static void integer_overflow 106, -static long left_shift 107, -static long right_shift 108, - struct constant 113, - struct constant {long value;113, - struct constant {long value; int unsignedp;113, - struct constant {long value; int unsignedp;} integer;113, - struct name 114, - struct name {U_CHAR *address;address114, - struct name {U_CHAR *address; int length;114, - struct name {U_CHAR *address; int length;} name;114, - struct arglist *keywords;keywords115, - int voidval;116, - char *sval;sval117, -} yystype;118, -# define YYSTYPE 119, -# define YYDEBUG 122, -#define YYFINAL 127, -#define YYFLAG 128, -#define YYNTBASE 129, -#define YYTRANSLATE(132, -static const char yytranslate[yytranslate135, -static const short yyprhs[yyprhs167, -static const short yyrhs[yyrhs174, -static const short yyrline[yyrline195, -static const char *const yytname[yytname208, -static const short yyr1[yyr1219, -static const short yyr2[yyr2228, -static const short yydefact[yydefact239, -static const short yydefgoto[yydefgoto251, -static const short yypact[yypact256, -static const short yypgoto[yypgoto268, -#define YYLAST 274, -static const short yytable[yytable277, -static const short yycheck[yycheck301, -static char *lexptr;lexptr332, -parse_number 341, -struct token 437, - char *operator;operator438, - int token;439, -static struct token tokentab2[tokentab2442, -yylex 459, -parse_escape 740, -yyerror 836, -integer_overflow 844, -left_shift 851, -right_shift 873, -parse_c_expression 893, -extern int yydebug;919, -main 923, -unsigned char is_idchar[is_idchar948, -unsigned char is_idstart[is_idstart950, -char is_hor_space[is_hor_space953, -initialize_random_junk 958, -error 988, -warning 993, -lookup 999, - /usr/share/bison/bison.simple,2238 # define YYSTD(41, # define YYSTD(43, diff --git a/test/etags/Makefile b/test/manual/etags/Makefile index 6e335711ff2..07ad0f46416 100644 --- a/test/etags/Makefile +++ b/test/manual/etags/Makefile @@ -33,8 +33,8 @@ SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\ ${PROLSRC} ${PYTSRC} ${RBSRC} ${TEXSRC} ${YSRC} NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz -ETAGS_PROG=../../lib-src/etags -CTAGS_PROG=../../lib-src/ctags +ETAGS_PROG=../../../lib-src/etags +CTAGS_PROG=../../../lib-src/ctags REGEX=/[ \t]*DEFVAR_[A-Z_ \t\n(]+"\([^"]+\)"/ xx="this line is here because of a fontlock bug diff --git a/test/etags/a-src/empty.zz b/test/manual/etags/a-src/empty.zz index e69de29bb2d..e69de29bb2d 100644 --- a/test/etags/a-src/empty.zz +++ b/test/manual/etags/a-src/empty.zz diff --git a/test/etags/a-src/empty.zz.gz b/test/manual/etags/a-src/empty.zz.gz index e69de29bb2d..e69de29bb2d 100644 --- a/test/etags/a-src/empty.zz.gz +++ b/test/manual/etags/a-src/empty.zz.gz diff --git a/test/etags/ada-src/2ataspri.adb b/test/manual/etags/ada-src/2ataspri.adb index 43ca983824c..43ca983824c 100644 --- a/test/etags/ada-src/2ataspri.adb +++ b/test/manual/etags/ada-src/2ataspri.adb diff --git a/test/etags/ada-src/2ataspri.ads b/test/manual/etags/ada-src/2ataspri.ads index 01c786028ab..01c786028ab 100644 --- a/test/etags/ada-src/2ataspri.ads +++ b/test/manual/etags/ada-src/2ataspri.ads diff --git a/test/etags/ada-src/etags-test-for.ada b/test/manual/etags/ada-src/etags-test-for.ada index 09e5a1ec9bf..09e5a1ec9bf 100644 --- a/test/etags/ada-src/etags-test-for.ada +++ b/test/manual/etags/ada-src/etags-test-for.ada diff --git a/test/etags/ada-src/waroquiers.ada b/test/manual/etags/ada-src/waroquiers.ada index 316120998f8..316120998f8 100644 --- a/test/etags/ada-src/waroquiers.ada +++ b/test/manual/etags/ada-src/waroquiers.ada diff --git a/test/etags/c-src/a/b/b.c b/test/manual/etags/c-src/a/b/b.c index ee3c97c2456..ee3c97c2456 100644 --- a/test/etags/c-src/a/b/b.c +++ b/test/manual/etags/c-src/a/b/b.c diff --git a/test/etags/c-src/abbrev.c b/test/manual/etags/c-src/abbrev.c index b7d137cd9bd..b7d137cd9bd 100644 --- a/test/etags/c-src/abbrev.c +++ b/test/manual/etags/c-src/abbrev.c diff --git a/test/etags/c-src/c.c b/test/manual/etags/c-src/c.c index 77c8929afb2..77c8929afb2 100644 --- a/test/etags/c-src/c.c +++ b/test/manual/etags/c-src/c.c diff --git a/test/etags/c-src/dostorture.c b/test/manual/etags/c-src/dostorture.c index 5190734e0fe..5190734e0fe 100644 --- a/test/etags/c-src/dostorture.c +++ b/test/manual/etags/c-src/dostorture.c diff --git a/test/etags/c-src/emacs/src/gmalloc.c b/test/manual/etags/c-src/emacs/src/gmalloc.c index 683ee0c9502..683ee0c9502 100644 --- a/test/etags/c-src/emacs/src/gmalloc.c +++ b/test/manual/etags/c-src/emacs/src/gmalloc.c diff --git a/test/etags/c-src/emacs/src/keyboard.c b/test/manual/etags/c-src/emacs/src/keyboard.c index 68584ee71fc..68584ee71fc 100644 --- a/test/etags/c-src/emacs/src/keyboard.c +++ b/test/manual/etags/c-src/emacs/src/keyboard.c diff --git a/test/etags/c-src/emacs/src/lisp.h b/test/manual/etags/c-src/emacs/src/lisp.h index db8722917ea..db8722917ea 100644 --- a/test/etags/c-src/emacs/src/lisp.h +++ b/test/manual/etags/c-src/emacs/src/lisp.h diff --git a/test/etags/c-src/emacs/src/regex.h b/test/manual/etags/c-src/emacs/src/regex.h index f97c1cb38c1..f97c1cb38c1 100644 --- a/test/etags/c-src/emacs/src/regex.h +++ b/test/manual/etags/c-src/emacs/src/regex.h diff --git a/test/etags/c-src/etags.c b/test/manual/etags/c-src/etags.c index 453419897bc..453419897bc 100644 --- a/test/etags/c-src/etags.c +++ b/test/manual/etags/c-src/etags.c diff --git a/test/etags/c-src/exit.c b/test/manual/etags/c-src/exit.c index 86afda9ed01..86afda9ed01 100644 --- a/test/etags/c-src/exit.c +++ b/test/manual/etags/c-src/exit.c diff --git a/test/etags/c-src/exit.strange_suffix b/test/manual/etags/c-src/exit.strange_suffix index 86afda9ed01..86afda9ed01 100644 --- a/test/etags/c-src/exit.strange_suffix +++ b/test/manual/etags/c-src/exit.strange_suffix diff --git a/test/etags/c-src/fail.c b/test/manual/etags/c-src/fail.c index 32482781b11..32482781b11 100644 --- a/test/etags/c-src/fail.c +++ b/test/manual/etags/c-src/fail.c diff --git a/test/etags/c-src/getopt.h b/test/manual/etags/c-src/getopt.h index aa2eb1dc173..aa2eb1dc173 100644 --- a/test/etags/c-src/getopt.h +++ b/test/manual/etags/c-src/getopt.h diff --git a/test/etags/c-src/h.h b/test/manual/etags/c-src/h.h index f86c00d64ad..f86c00d64ad 100644 --- a/test/etags/c-src/h.h +++ b/test/manual/etags/c-src/h.h diff --git a/test/etags/c-src/machsyscalls.c b/test/manual/etags/c-src/machsyscalls.c index 44930c33cf3..44930c33cf3 100644 --- a/test/etags/c-src/machsyscalls.c +++ b/test/manual/etags/c-src/machsyscalls.c diff --git a/test/etags/c-src/machsyscalls.h b/test/manual/etags/c-src/machsyscalls.h index 8b33dc4e7e5..8b33dc4e7e5 100644 --- a/test/etags/c-src/machsyscalls.h +++ b/test/manual/etags/c-src/machsyscalls.h diff --git a/test/etags/c-src/sysdep.h b/test/manual/etags/c-src/sysdep.h index 6409fcc1e1d..6409fcc1e1d 100644 --- a/test/etags/c-src/sysdep.h +++ b/test/manual/etags/c-src/sysdep.h diff --git a/test/etags/c-src/tab.c b/test/manual/etags/c-src/tab.c index b25d55cb2e8..b25d55cb2e8 100644 --- a/test/etags/c-src/tab.c +++ b/test/manual/etags/c-src/tab.c diff --git a/test/etags/c-src/torture.c b/test/manual/etags/c-src/torture.c index 77c3763564a..77c3763564a 100644 --- a/test/etags/c-src/torture.c +++ b/test/manual/etags/c-src/torture.c diff --git a/test/etags/cp-src/MDiagArray2.h b/test/manual/etags/cp-src/MDiagArray2.h index 78ee5e1523c..78ee5e1523c 100644 --- a/test/etags/cp-src/MDiagArray2.h +++ b/test/manual/etags/cp-src/MDiagArray2.h diff --git a/test/etags/cp-src/Range.h b/test/manual/etags/cp-src/Range.h index b8cbab47ebf..b8cbab47ebf 100644 --- a/test/etags/cp-src/Range.h +++ b/test/manual/etags/cp-src/Range.h diff --git a/test/etags/cp-src/burton.cpp b/test/manual/etags/cp-src/burton.cpp index d86ad758d81..d86ad758d81 100644 --- a/test/etags/cp-src/burton.cpp +++ b/test/manual/etags/cp-src/burton.cpp diff --git a/test/etags/cp-src/c.C b/test/manual/etags/cp-src/c.C index 2c5f7e01fac..2c5f7e01fac 100644 --- a/test/etags/cp-src/c.C +++ b/test/manual/etags/cp-src/c.C diff --git a/test/etags/cp-src/clheir.cpp.gz b/test/manual/etags/cp-src/clheir.cpp.gz Binary files differindex 38b08a8e7f8..38b08a8e7f8 100644 --- a/test/etags/cp-src/clheir.cpp.gz +++ b/test/manual/etags/cp-src/clheir.cpp.gz diff --git a/test/etags/cp-src/clheir.hpp b/test/manual/etags/cp-src/clheir.hpp index 55d91228fb3..55d91228fb3 100644 --- a/test/etags/cp-src/clheir.hpp +++ b/test/manual/etags/cp-src/clheir.hpp diff --git a/test/etags/cp-src/conway.cpp b/test/manual/etags/cp-src/conway.cpp index 1e600147ed9..1e600147ed9 100644 --- a/test/etags/cp-src/conway.cpp +++ b/test/manual/etags/cp-src/conway.cpp diff --git a/test/etags/cp-src/conway.hpp b/test/manual/etags/cp-src/conway.hpp index 9fbb2517526..9fbb2517526 100644 --- a/test/etags/cp-src/conway.hpp +++ b/test/manual/etags/cp-src/conway.hpp diff --git a/test/etags/cp-src/fail.C b/test/manual/etags/cp-src/fail.C index c602ed26396..c602ed26396 100644 --- a/test/etags/cp-src/fail.C +++ b/test/manual/etags/cp-src/fail.C diff --git a/test/etags/cp-src/functions.cpp b/test/manual/etags/cp-src/functions.cpp index fb546ed4de8..764498d4084 100644 --- a/test/etags/cp-src/functions.cpp +++ b/test/manual/etags/cp-src/functions.cpp @@ -1,7 +1,7 @@ #include "main.hpp" #pragma ident "@(#)functions.cpp 1.0 98/11/12 (c) Rupak Rathore" -// Constructor default argument initialises to today's values +// Constructor default argument initializes to today's values void Date::setDate ( int d , int m , int y ){ time_t t; struct tm * ptm; @@ -9,9 +9,9 @@ void Date::setDate ( int d , int m , int y ){ if ( date != NULL ) delete date; date = NULL; - if ( d == 0 && m == 0 && y == 0 ) // explicity called or default constructor hence leave it. + if ( d == 0 && m == 0 && y == 0 ) //Explicitly called or default constructor hence leave it. return; - if ( d < 0 && m < 0 && d < 0 ) // Special instruction to intialise to today's value + if ( d < 0 && m < 0 && d < 0 ) //Special instruction to initialize to today's value d=m=y=0; date = new tm; ptm=localtime ( &t ) ; diff --git a/test/etags/cp-src/screen.cpp b/test/manual/etags/cp-src/screen.cpp index 1958a19d628..1958a19d628 100644 --- a/test/etags/cp-src/screen.cpp +++ b/test/manual/etags/cp-src/screen.cpp diff --git a/test/etags/cp-src/screen.hpp b/test/manual/etags/cp-src/screen.hpp index a7099a3379d..a7099a3379d 100644 --- a/test/etags/cp-src/screen.hpp +++ b/test/manual/etags/cp-src/screen.hpp diff --git a/test/etags/cp-src/x.cc b/test/manual/etags/cp-src/x.cc index a236060281a..a236060281a 100644 --- a/test/etags/cp-src/x.cc +++ b/test/manual/etags/cp-src/x.cc diff --git a/test/etags/el-src/TAGTEST.EL b/test/manual/etags/el-src/TAGTEST.EL index acf0baf82f0..acf0baf82f0 100644 --- a/test/etags/el-src/TAGTEST.EL +++ b/test/manual/etags/el-src/TAGTEST.EL diff --git a/test/etags/el-src/emacs/lisp/progmodes/etags.el b/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el index 5d28657e28b..5d28657e28b 100644 --- a/test/etags/el-src/emacs/lisp/progmodes/etags.el +++ b/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el diff --git a/test/etags/erl-src/gs_dialog.erl b/test/manual/etags/erl-src/gs_dialog.erl index c04ee8be0cd..c04ee8be0cd 100644 --- a/test/etags/erl-src/gs_dialog.erl +++ b/test/manual/etags/erl-src/gs_dialog.erl diff --git a/test/etags/f-src/entry.for b/test/manual/etags/f-src/entry.for index 52b8a2487c6..52b8a2487c6 100644 --- a/test/etags/f-src/entry.for +++ b/test/manual/etags/f-src/entry.for diff --git a/test/etags/f-src/entry.strange.gz b/test/manual/etags/f-src/entry.strange.gz Binary files differindex 5f22edc86bb..5f22edc86bb 100644 --- a/test/etags/f-src/entry.strange.gz +++ b/test/manual/etags/f-src/entry.strange.gz diff --git a/test/etags/f-src/entry.strange_suffix b/test/manual/etags/f-src/entry.strange_suffix index 52b8a2487c6..52b8a2487c6 100644 --- a/test/etags/f-src/entry.strange_suffix +++ b/test/manual/etags/f-src/entry.strange_suffix diff --git a/test/etags/forth-src/test-forth.fth b/test/manual/etags/forth-src/test-forth.fth index ce4069dfa8f..4521d32fae4 100644 --- a/test/etags/forth-src/test-forth.fth +++ b/test/manual/etags/forth-src/test-forth.fth @@ -51,3 +51,24 @@ c; a-forth-word dup 200 > abort" Eek. The number is too big" ." Result is " . cr ; + +: (foo) 1 ; +: foo (foo) ; + +: create-bar foo ; +create-bar \ Do NOT create a tag here + +3 4 2constant 2const +2const 2value 2val +2variable 2var + +3.1415e fconstant fconst +fconst fvalue fval +fvariable fvar + +synonym mypi fconst + +BEGIN-STRUCTURE point \ create the named structure + 1 CELLS +FIELD p.x \ A single cell filed named p.x + 1 CELLS +FIELD p.y \ A single cell field named p.y +END-STRUCTURE diff --git a/test/etags/go-src/test.go b/test/manual/etags/go-src/test.go index 6aea26ef210..6aea26ef210 100644 --- a/test/etags/go-src/test.go +++ b/test/manual/etags/go-src/test.go diff --git a/test/etags/go-src/test1.go b/test/manual/etags/go-src/test1.go index 6d1efaaa8a9..6d1efaaa8a9 100644 --- a/test/etags/go-src/test1.go +++ b/test/manual/etags/go-src/test1.go diff --git a/test/etags/html-src/algrthms.html b/test/manual/etags/html-src/algrthms.html index becd93a62d0..becd93a62d0 100644 --- a/test/etags/html-src/algrthms.html +++ b/test/manual/etags/html-src/algrthms.html diff --git a/test/etags/html-src/index.shtml b/test/manual/etags/html-src/index.shtml index 6d8cd858855..6d8cd858855 100644 --- a/test/etags/html-src/index.shtml +++ b/test/manual/etags/html-src/index.shtml diff --git a/test/etags/html-src/software.html b/test/manual/etags/html-src/software.html index b5de1e6d686..f1abba7cb49 100644 --- a/test/etags/html-src/software.html +++ b/test/manual/etags/html-src/software.html @@ -123,7 +123,7 @@ HREF="ftp://fly.cnuce.cnr.it/pub/software/octave/leasqr/">published</A> it. Since then, the original authors Richard I. Shrager, A.Jutan, Ray Muzic, and Sean Brennan agreed to put it under the <A HREF="http://www.gnu.org/licenses/gpl.html">GPL</A>. Matthias Jueschke tested -the program using a non-linear optimisation <A +the program using a non-linear optimization <A HREF="http://www.itl.nist.gov/div898/strd/nls/nls_main.shtml">test suite</A>, and was satisfied with the results. @@ -168,7 +168,7 @@ if that happens so I can update this page. Shows the location of the first read error detected. Can extract a disk Id from the image or the CD itself and build a local database of Ids for future checking of archived CDs. The Id contains the image length, the MD5 - signature and the Volume ID of the disk, so it can automatically recognise + signature and the Volume ID of the disk, so it can automatically recognize the CD to check. Contains a small internal database of <A HREF="http://www.debian.org/">Debian</A> <A HREF="http://cdimage.debian.org/">CD images</A>. diff --git a/test/etags/html-src/softwarelibero.html b/test/manual/etags/html-src/softwarelibero.html index b374273c969..b374273c969 100644 --- a/test/etags/html-src/softwarelibero.html +++ b/test/manual/etags/html-src/softwarelibero.html diff --git a/test/etags/lua-src/allegro.lua b/test/manual/etags/lua-src/allegro.lua index c316b6f26a0..c316b6f26a0 100644 --- a/test/etags/lua-src/allegro.lua +++ b/test/manual/etags/lua-src/allegro.lua diff --git a/test/etags/lua-src/test.lua b/test/manual/etags/lua-src/test.lua index 405eb5f1de0..405eb5f1de0 100644 --- a/test/etags/lua-src/test.lua +++ b/test/manual/etags/lua-src/test.lua diff --git a/test/etags/make-src/Makefile b/test/manual/etags/make-src/Makefile index 016c633d791..016c633d791 100644 --- a/test/etags/make-src/Makefile +++ b/test/manual/etags/make-src/Makefile diff --git a/test/etags/objc-src/PackInsp.h b/test/manual/etags/objc-src/PackInsp.h index 0e3643c8281..0e3643c8281 100644 --- a/test/etags/objc-src/PackInsp.h +++ b/test/manual/etags/objc-src/PackInsp.h diff --git a/test/etags/objc-src/PackInsp.m b/test/manual/etags/objc-src/PackInsp.m index 41cc876850f..41cc876850f 100644 --- a/test/etags/objc-src/PackInsp.m +++ b/test/manual/etags/objc-src/PackInsp.m diff --git a/test/etags/objc-src/Subprocess.h b/test/manual/etags/objc-src/Subprocess.h index 7e586a16a12..7e586a16a12 100644 --- a/test/etags/objc-src/Subprocess.h +++ b/test/manual/etags/objc-src/Subprocess.h diff --git a/test/etags/objc-src/Subprocess.m b/test/manual/etags/objc-src/Subprocess.m index 2d8d586507e..2d8d586507e 100644 --- a/test/etags/objc-src/Subprocess.m +++ b/test/manual/etags/objc-src/Subprocess.m diff --git a/test/etags/objcpp-src/SimpleCalc.H b/test/manual/etags/objcpp-src/SimpleCalc.H index 121ae6bada3..121ae6bada3 100644 --- a/test/etags/objcpp-src/SimpleCalc.H +++ b/test/manual/etags/objcpp-src/SimpleCalc.H diff --git a/test/etags/objcpp-src/SimpleCalc.M b/test/manual/etags/objcpp-src/SimpleCalc.M index 34846a7aceb..34846a7aceb 100644 --- a/test/etags/objcpp-src/SimpleCalc.M +++ b/test/manual/etags/objcpp-src/SimpleCalc.M diff --git a/test/etags/pas-src/common.pas b/test/manual/etags/pas-src/common.pas index ec8e80c4a7a..ec8e80c4a7a 100644 --- a/test/etags/pas-src/common.pas +++ b/test/manual/etags/pas-src/common.pas diff --git a/test/etags/perl-src/htlmify-cystic b/test/manual/etags/perl-src/htlmify-cystic index de150a72b8f..de150a72b8f 100644 --- a/test/etags/perl-src/htlmify-cystic +++ b/test/manual/etags/perl-src/htlmify-cystic diff --git a/test/etags/perl-src/kai-test.pl b/test/manual/etags/perl-src/kai-test.pl index 51b66728f1e..51b66728f1e 100644 --- a/test/etags/perl-src/kai-test.pl +++ b/test/manual/etags/perl-src/kai-test.pl diff --git a/test/etags/perl-src/yagrip.pl b/test/manual/etags/perl-src/yagrip.pl index be9f09c02d4..be9f09c02d4 100644 --- a/test/etags/perl-src/yagrip.pl +++ b/test/manual/etags/perl-src/yagrip.pl diff --git a/test/etags/php-src/lce_functions.php b/test/manual/etags/php-src/lce_functions.php index 65738134593..65738134593 100644 --- a/test/etags/php-src/lce_functions.php +++ b/test/manual/etags/php-src/lce_functions.php diff --git a/test/etags/php-src/ptest.php b/test/manual/etags/php-src/ptest.php index 9893839b493..9893839b493 100644 --- a/test/etags/php-src/ptest.php +++ b/test/manual/etags/php-src/ptest.php diff --git a/test/etags/php-src/sendmail.php b/test/manual/etags/php-src/sendmail.php index 1d15e4ad9f6..1d15e4ad9f6 100644 --- a/test/etags/php-src/sendmail.php +++ b/test/manual/etags/php-src/sendmail.php diff --git a/test/etags/prol-src/natded.prolog b/test/manual/etags/prol-src/natded.prolog index f0ee6b41b12..f0ee6b41b12 100644 --- a/test/etags/prol-src/natded.prolog +++ b/test/manual/etags/prol-src/natded.prolog diff --git a/test/etags/prol-src/ordsets.prolog b/test/manual/etags/prol-src/ordsets.prolog index 7192129fdce..7192129fdce 100644 --- a/test/etags/prol-src/ordsets.prolog +++ b/test/manual/etags/prol-src/ordsets.prolog diff --git a/test/etags/ps-src/rfc1245.ps b/test/manual/etags/ps-src/rfc1245.ps index ad2244f1dc0..ad2244f1dc0 100644 --- a/test/etags/ps-src/rfc1245.ps +++ b/test/manual/etags/ps-src/rfc1245.ps diff --git a/test/etags/pyt-src/server.py b/test/manual/etags/pyt-src/server.py index 68aa29abcfd..68aa29abcfd 100644 --- a/test/etags/pyt-src/server.py +++ b/test/manual/etags/pyt-src/server.py diff --git a/test/etags/ruby-src/test.rb b/test/manual/etags/ruby-src/test.rb index adb2cb1d0bc..adb2cb1d0bc 100644 --- a/test/etags/ruby-src/test.rb +++ b/test/manual/etags/ruby-src/test.rb diff --git a/test/etags/ruby-src/test1.ru b/test/manual/etags/ruby-src/test1.ru index eafaec6248b..eafaec6248b 100644 --- a/test/etags/ruby-src/test1.ru +++ b/test/manual/etags/ruby-src/test1.ru diff --git a/test/etags/tex-src/gzip.texi b/test/manual/etags/tex-src/gzip.texi index 07be37187d7..07be37187d7 100644 --- a/test/etags/tex-src/gzip.texi +++ b/test/manual/etags/tex-src/gzip.texi diff --git a/test/etags/tex-src/nonewline.tex b/test/manual/etags/tex-src/nonewline.tex index 8cc01ce9151..8cc01ce9151 100644 --- a/test/etags/tex-src/nonewline.tex +++ b/test/manual/etags/tex-src/nonewline.tex diff --git a/test/etags/tex-src/testenv.tex b/test/manual/etags/tex-src/testenv.tex index efb83cb834f..efb83cb834f 100644 --- a/test/etags/tex-src/testenv.tex +++ b/test/manual/etags/tex-src/testenv.tex diff --git a/test/etags/tex-src/texinfo.tex b/test/manual/etags/tex-src/texinfo.tex index aa745c68471..aa745c68471 100644 --- a/test/etags/tex-src/texinfo.tex +++ b/test/manual/etags/tex-src/texinfo.tex diff --git a/test/etags/y-src/atest.y b/test/manual/etags/y-src/atest.y index 81087b8d86e..81087b8d86e 100644 --- a/test/etags/y-src/atest.y +++ b/test/manual/etags/y-src/atest.y diff --git a/test/etags/y-src/cccp.c b/test/manual/etags/y-src/cccp.c index 776e3dad4b0..022fbe0a72f 100644 --- a/test/etags/y-src/cccp.c +++ b/test/manual/etags/y-src/cccp.c @@ -17,7 +17,7 @@ # define RSH 268 # define UNARY 269 -#line 26 "cccp.y" +#line 26 "y-src/cccp.y" #include "config.h" #include <setjmp.h> @@ -102,7 +102,7 @@ static void integer_overflow (); static long left_shift (); static long right_shift (); -#line 111 "cccp.y" +#line 111 "y-src/cccp.y" #ifndef YYSTYPE typedef union { struct constant {long value; int unsignedp;} integer; @@ -1047,59 +1047,59 @@ yyreduce: switch (yyn) { case 1: -#line 144 "cccp.y" +#line 144 "y-src/cccp.y" { expression_value = yyvsp[0].integer.value; } break; case 3: -#line 150 "cccp.y" +#line 150 "y-src/cccp.y" { if (pedantic) pedwarn ("comma operator in operand of `#if'"); yyval.integer = yyvsp[0].integer; } break; case 4: -#line 157 "cccp.y" +#line 157 "y-src/cccp.y" { yyval.integer.value = - yyvsp[0].integer.value; if ((yyval.integer.value & yyvsp[0].integer.value) < 0 && ! yyvsp[0].integer.unsignedp) integer_overflow (); yyval.integer.unsignedp = yyvsp[0].integer.unsignedp; } break; case 5: -#line 162 "cccp.y" +#line 162 "y-src/cccp.y" { yyval.integer.value = ! yyvsp[0].integer.value; yyval.integer.unsignedp = 0; } break; case 6: -#line 165 "cccp.y" +#line 165 "y-src/cccp.y" { yyval.integer = yyvsp[0].integer; } break; case 7: -#line 167 "cccp.y" +#line 167 "y-src/cccp.y" { yyval.integer.value = ~ yyvsp[0].integer.value; yyval.integer.unsignedp = yyvsp[0].integer.unsignedp; } break; case 8: -#line 170 "cccp.y" +#line 170 "y-src/cccp.y" { yyval.integer.value = check_assertion (yyvsp[0].name.address, yyvsp[0].name.length, 0, NULL_PTR); yyval.integer.unsignedp = 0; } break; case 9: -#line 174 "cccp.y" +#line 174 "y-src/cccp.y" { keyword_parsing = 1; } break; case 10: -#line 176 "cccp.y" +#line 176 "y-src/cccp.y" { yyval.integer.value = check_assertion (yyvsp[-4].name.address, yyvsp[-4].name.length, 1, yyvsp[-1].keywords); keyword_parsing = 0; yyval.integer.unsignedp = 0; } break; case 11: -#line 181 "cccp.y" +#line 181 "y-src/cccp.y" { yyval.integer = yyvsp[-1].integer; } break; case 12: -#line 186 "cccp.y" +#line 186 "y-src/cccp.y" { yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp; if (yyval.integer.unsignedp) yyval.integer.value = (unsigned long) yyvsp[-2].integer.value * yyvsp[0].integer.value; @@ -1113,7 +1113,7 @@ case 12: } } break; case 13: -#line 198 "cccp.y" +#line 198 "y-src/cccp.y" { if (yyvsp[0].integer.value == 0) { error ("division by zero in #if"); @@ -1130,7 +1130,7 @@ case 13: } } break; case 14: -#line 213 "cccp.y" +#line 213 "y-src/cccp.y" { if (yyvsp[0].integer.value == 0) { error ("division by zero in #if"); @@ -1143,7 +1143,7 @@ case 14: yyval.integer.value = yyvsp[-2].integer.value % yyvsp[0].integer.value; } break; case 15: -#line 224 "cccp.y" +#line 224 "y-src/cccp.y" { yyval.integer.value = yyvsp[-2].integer.value + yyvsp[0].integer.value; yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp; if (! yyval.integer.unsignedp @@ -1152,7 +1152,7 @@ case 15: integer_overflow (); } break; case 16: -#line 231 "cccp.y" +#line 231 "y-src/cccp.y" { yyval.integer.value = yyvsp[-2].integer.value - yyvsp[0].integer.value; yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp; if (! yyval.integer.unsignedp @@ -1161,7 +1161,7 @@ case 16: integer_overflow (); } break; case 17: -#line 238 "cccp.y" +#line 238 "y-src/cccp.y" { yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp; if (yyvsp[0].integer.value < 0 && ! yyvsp[0].integer.unsignedp) yyval.integer.value = right_shift (&yyvsp[-2].integer, -yyvsp[0].integer.value); @@ -1169,7 +1169,7 @@ case 17: yyval.integer.value = left_shift (&yyvsp[-2].integer, yyvsp[0].integer.value); } break; case 18: -#line 244 "cccp.y" +#line 244 "y-src/cccp.y" { yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp; if (yyvsp[0].integer.value < 0 && ! yyvsp[0].integer.unsignedp) yyval.integer.value = left_shift (&yyvsp[-2].integer, -yyvsp[0].integer.value); @@ -1177,17 +1177,17 @@ case 18: yyval.integer.value = right_shift (&yyvsp[-2].integer, yyvsp[0].integer.value); } break; case 19: -#line 250 "cccp.y" +#line 250 "y-src/cccp.y" { yyval.integer.value = (yyvsp[-2].integer.value == yyvsp[0].integer.value); yyval.integer.unsignedp = 0; } break; case 20: -#line 253 "cccp.y" +#line 253 "y-src/cccp.y" { yyval.integer.value = (yyvsp[-2].integer.value != yyvsp[0].integer.value); yyval.integer.unsignedp = 0; } break; case 21: -#line 256 "cccp.y" +#line 256 "y-src/cccp.y" { yyval.integer.unsignedp = 0; if (yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp) yyval.integer.value = (unsigned long) yyvsp[-2].integer.value <= yyvsp[0].integer.value; @@ -1195,7 +1195,7 @@ case 21: yyval.integer.value = yyvsp[-2].integer.value <= yyvsp[0].integer.value; } break; case 22: -#line 262 "cccp.y" +#line 262 "y-src/cccp.y" { yyval.integer.unsignedp = 0; if (yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp) yyval.integer.value = (unsigned long) yyvsp[-2].integer.value >= yyvsp[0].integer.value; @@ -1203,7 +1203,7 @@ case 22: yyval.integer.value = yyvsp[-2].integer.value >= yyvsp[0].integer.value; } break; case 23: -#line 268 "cccp.y" +#line 268 "y-src/cccp.y" { yyval.integer.unsignedp = 0; if (yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp) yyval.integer.value = (unsigned long) yyvsp[-2].integer.value < yyvsp[0].integer.value; @@ -1211,7 +1211,7 @@ case 23: yyval.integer.value = yyvsp[-2].integer.value < yyvsp[0].integer.value; } break; case 24: -#line 274 "cccp.y" +#line 274 "y-src/cccp.y" { yyval.integer.unsignedp = 0; if (yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp) yyval.integer.value = (unsigned long) yyvsp[-2].integer.value > yyvsp[0].integer.value; @@ -1219,54 +1219,54 @@ case 24: yyval.integer.value = yyvsp[-2].integer.value > yyvsp[0].integer.value; } break; case 25: -#line 280 "cccp.y" +#line 280 "y-src/cccp.y" { yyval.integer.value = yyvsp[-2].integer.value & yyvsp[0].integer.value; yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp; } break; case 26: -#line 283 "cccp.y" +#line 283 "y-src/cccp.y" { yyval.integer.value = yyvsp[-2].integer.value ^ yyvsp[0].integer.value; yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp; } break; case 27: -#line 286 "cccp.y" +#line 286 "y-src/cccp.y" { yyval.integer.value = yyvsp[-2].integer.value | yyvsp[0].integer.value; yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp; } break; case 28: -#line 289 "cccp.y" +#line 289 "y-src/cccp.y" { yyval.integer.value = (yyvsp[-2].integer.value && yyvsp[0].integer.value); yyval.integer.unsignedp = 0; } break; case 29: -#line 292 "cccp.y" +#line 292 "y-src/cccp.y" { yyval.integer.value = (yyvsp[-2].integer.value || yyvsp[0].integer.value); yyval.integer.unsignedp = 0; } break; case 30: -#line 295 "cccp.y" +#line 295 "y-src/cccp.y" { yyval.integer.value = yyvsp[-4].integer.value ? yyvsp[-2].integer.value : yyvsp[0].integer.value; yyval.integer.unsignedp = yyvsp[-2].integer.unsignedp || yyvsp[0].integer.unsignedp; } break; case 31: -#line 298 "cccp.y" +#line 298 "y-src/cccp.y" { yyval.integer = yylval.integer; } break; case 32: -#line 300 "cccp.y" +#line 300 "y-src/cccp.y" { yyval.integer = yylval.integer; } break; case 33: -#line 302 "cccp.y" +#line 302 "y-src/cccp.y" { yyval.integer.value = 0; yyval.integer.unsignedp = 0; } break; case 34: -#line 307 "cccp.y" +#line 307 "y-src/cccp.y" { yyval.keywords = 0; } break; case 35: -#line 309 "cccp.y" +#line 309 "y-src/cccp.y" { struct arglist *temp; yyval.keywords = (struct arglist *) xmalloc (sizeof (struct arglist)); yyval.keywords->next = yyvsp[-2].keywords; @@ -1281,7 +1281,7 @@ case 35: temp->next->length = 1; } break; case 36: -#line 322 "cccp.y" +#line 322 "y-src/cccp.y" { yyval.keywords = (struct arglist *) xmalloc (sizeof (struct arglist)); yyval.keywords->name = yyvsp[-1].name.address; yyval.keywords->length = yyvsp[-1].name.length; @@ -1520,7 +1520,7 @@ yyreturn: #endif return yyresult; } -#line 327 "cccp.y" +#line 327 "y-src/cccp.y" /* During parsing of a C expression, the pointer to the next character diff --git a/test/etags/y-src/cccp.y b/test/manual/etags/y-src/cccp.y index 1cd2111464c..1cd2111464c 100644 --- a/test/etags/y-src/cccp.y +++ b/test/manual/etags/y-src/cccp.y diff --git a/test/etags/y-src/parse.c b/test/manual/etags/y-src/parse.c index 95098674279..d21af68b9bb 100644 --- a/test/etags/y-src/parse.c +++ b/test/manual/etags/y-src/parse.c @@ -26,7 +26,7 @@ # define L_NE 277 # define L_GE 278 -#line 1 "parse.y" +#line 1 "y-src/parse.y" /* Copyright (C) 1990, 1992-1993, 2016 Free Software Foundation, Inc. @@ -45,7 +45,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with Oleo; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ -#line 41 "parse.y" +#line 41 "y-src/parse.y" #include "funcdef.h" @@ -1125,84 +1125,84 @@ yyreduce: switch (yyn) { case 1: -#line 87 "parse.y" +#line 87 "y-src/parse.y" { parse_return=yyvsp[0]; } break; case 2: -#line 88 "parse.y" +#line 88 "y-src/parse.y" { if(!parse_error) parse_error=PARSE_ERR; parse_return=0; } break; case 5: -#line 96 "parse.y" +#line 96 "y-src/parse.y" { yyval=yyvsp[-2]; } break; case 6: -#line 98 "parse.y" +#line 98 "y-src/parse.y" { (yyvsp[-3])->n_x.v_subs[0]=yyvsp[-1]; (yyvsp[-3])->n_x.v_subs[1]=(struct node *)0; yyval=yyvsp[-3]; } break; case 7: -#line 102 "parse.y" +#line 102 "y-src/parse.y" { (yyvsp[-5])->n_x.v_subs[0]=yyvsp[-3]; (yyvsp[-5])->n_x.v_subs[1]=yyvsp[-1]; yyval=yyvsp[-5]; } break; case 8: -#line 106 "parse.y" +#line 106 "y-src/parse.y" { (yyvsp[-7])->n_x.v_subs[0]=make_list(yyvsp[-5],yyvsp[-3]); (yyvsp[-7])->n_x.v_subs[1]=yyvsp[-1]; yyval=yyvsp[-7];} break; case 9: -#line 110 "parse.y" +#line 110 "y-src/parse.y" { (yyvsp[-9])->n_x.v_subs[0]=make_list(yyvsp[-7],yyvsp[-5]); (yyvsp[-9])->n_x.v_subs[1]=make_list(yyvsp[-3],yyvsp[-1]); yyval=yyvsp[-9];} break; case 10: -#line 114 "parse.y" +#line 114 "y-src/parse.y" { (yyvsp[-3])->n_x.v_subs[0]=(struct node *)0; (yyvsp[-3])->n_x.v_subs[1]=yyvsp[-1]; yyval=yyvsp[-3]; } break; case 11: -#line 118 "parse.y" +#line 118 "y-src/parse.y" { yyvsp[-3]->n_x.v_subs[0]=yyvsp[-1]; yyval=yyvsp[-3]; } break; case 12: -#line 121 "parse.y" +#line 121 "y-src/parse.y" { yyvsp[-3]->n_x.v_subs[0]=yyvsp[-1]; yyval=yyvsp[-3]; } break; case 13: -#line 125 "parse.y" +#line 125 "y-src/parse.y" { yyvsp[-5]->n_x.v_subs[0]=yyvsp[-3]; yyvsp[-5]->n_x.v_subs[1]=yyvsp[-1]; yyval=yyvsp[-5]; } break; case 14: -#line 129 "parse.y" +#line 129 "y-src/parse.y" { yyvsp[-5]->n_x.v_subs[0]=yyvsp[-3]; yyvsp[-5]->n_x.v_subs[1]=yyvsp[-1]; yyval=yyvsp[-5]; } break; case 15: -#line 135 "parse.y" +#line 135 "y-src/parse.y" { if(yyvsp[-7]->comp_value!=F_INDEX) parse_error=PARSE_ERR; @@ -1212,7 +1212,7 @@ case 15: yyval=yyvsp[-7]; } break; case 16: -#line 142 "parse.y" +#line 142 "y-src/parse.y" { if(yyvsp[-7]->comp_value!=F_INDEX) parse_error=PARSE_ERR; @@ -1222,28 +1222,28 @@ case 16: yyval=yyvsp[-7]; } break; case 17: -#line 150 "parse.y" +#line 150 "y-src/parse.y" { (yyvsp[-7])->n_x.v_subs[0]=make_list(yyvsp[-5],yyvsp[-3]); (yyvsp[-7])->n_x.v_subs[1]=yyvsp[-1]; yyval=yyvsp[-7];} break; case 18: -#line 154 "parse.y" +#line 154 "y-src/parse.y" { (yyvsp[-7])->n_x.v_subs[0]=make_list(yyvsp[-5],yyvsp[-3]); (yyvsp[-7])->n_x.v_subs[1]=yyvsp[-1]; yyval=yyvsp[-7];} break; case 19: -#line 159 "parse.y" +#line 159 "y-src/parse.y" { (yyvsp[-3])->n_x.v_subs[0]=(struct node *)0; (yyvsp[-3])->n_x.v_subs[1]=yyvsp[-1]; yyval=yyvsp[-3]; } break; case 20: -#line 163 "parse.y" +#line 163 "y-src/parse.y" { yyvsp[-3]->comp_value=IF; yyvsp[-3]->n_x.v_subs[0]=yyvsp[-1]; @@ -1253,98 +1253,98 @@ case 20: yyval=yyvsp[-3]; } break; case 21: -#line 174 "parse.y" +#line 174 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 22: -#line 178 "parse.y" +#line 178 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 23: -#line 182 "parse.y" +#line 182 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 24: -#line 186 "parse.y" +#line 186 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 25: -#line 190 "parse.y" +#line 190 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 26: -#line 194 "parse.y" +#line 194 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 27: -#line 198 "parse.y" +#line 198 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 28: -#line 202 "parse.y" +#line 202 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 29: -#line 206 "parse.y" +#line 206 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 30: -#line 210 "parse.y" +#line 210 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 31: -#line 214 "parse.y" +#line 214 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 32: -#line 218 "parse.y" +#line 218 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 33: -#line 222 "parse.y" +#line 222 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[-2]; yyvsp[-1]->n_x.v_subs[1]=yyvsp[0]; yyval = yyvsp[-1]; } break; case 34: -#line 226 "parse.y" +#line 226 "y-src/parse.y" { if(yyvsp[0]->comp_value==CONST_FLT) { yyvsp[0]->n_x.v_float= -(yyvsp[0]->n_x.v_float); @@ -1362,48 +1362,48 @@ case 34: } } break; case 35: -#line 241 "parse.y" +#line 241 "y-src/parse.y" { yyvsp[-1]->n_x.v_subs[0]=yyvsp[0]; yyvsp[-1]->n_x.v_subs[1]=(struct node *)0; yyval = yyvsp[-1]; } break; case 36: -#line 246 "parse.y" +#line 246 "y-src/parse.y" { yyval = yyvsp[-1]; } break; case 37: -#line 247 "parse.y" +#line 247 "y-src/parse.y" { if(!parse_error) parse_error=NO_CLOSE; } break; case 38: -#line 255 "parse.y" +#line 255 "y-src/parse.y" { if(!parse_error) parse_error=NO_CLOSE; } break; case 39: -#line 263 "parse.y" +#line 263 "y-src/parse.y" { yyval = make_list(yyvsp[0], 0); } break; case 40: -#line 265 "parse.y" +#line 265 "y-src/parse.y" { yyval = make_list(yyvsp[0], yyvsp[-2]); } break; case 43: -#line 273 "parse.y" +#line 273 "y-src/parse.y" { yyval=make_list(yyvsp[0], 0); } break; case 44: -#line 275 "parse.y" +#line 275 "y-src/parse.y" { yyval=make_list(yyvsp[0],yyvsp[-2]); } break; case 45: -#line 279 "parse.y" +#line 279 "y-src/parse.y" { yyval=yyvsp[0]; } break; } @@ -1639,7 +1639,7 @@ yyreturn: #endif return yyresult; } -#line 282 "parse.y" +#line 282 "y-src/parse.y" void diff --git a/test/etags/y-src/parse.y b/test/manual/etags/y-src/parse.y index 824c98d6245..824c98d6245 100644 --- a/test/etags/y-src/parse.y +++ b/test/manual/etags/y-src/parse.y diff --git a/test/indent/Makefile b/test/manual/indent/Makefile index 83162681d72..83162681d72 100644 --- a/test/indent/Makefile +++ b/test/manual/indent/Makefile diff --git a/test/indent/css-mode.css b/test/manual/indent/css-mode.css index 3a00739bfc4..3a00739bfc4 100644 --- a/test/indent/css-mode.css +++ b/test/manual/indent/css-mode.css diff --git a/test/indent/js-indent-init-dynamic.js b/test/manual/indent/js-indent-init-dynamic.js index 536a976e86e..536a976e86e 100644 --- a/test/indent/js-indent-init-dynamic.js +++ b/test/manual/indent/js-indent-init-dynamic.js diff --git a/test/indent/js-indent-init-t.js b/test/manual/indent/js-indent-init-t.js index bb755420ba7..bb755420ba7 100644 --- a/test/indent/js-indent-init-t.js +++ b/test/manual/indent/js-indent-init-t.js diff --git a/test/indent/js-jsx.js b/test/manual/indent/js-jsx.js index 7401939d282..7401939d282 100644 --- a/test/indent/js-jsx.js +++ b/test/manual/indent/js-jsx.js diff --git a/test/indent/js.js b/test/manual/indent/js.js index b40d47b3e5d..806e9497ad5 100644 --- a/test/indent/js.js +++ b/test/manual/indent/js.js @@ -69,6 +69,9 @@ a++ b += c +var re = /some value/ +str.match(re) + baz(`http://foo.bar/${tee}`) .qux(); diff --git a/test/indent/latex-mode.tex b/test/manual/indent/latex-mode.tex index 55c8e7033bd..55c8e7033bd 100644 --- a/test/indent/latex-mode.tex +++ b/test/manual/indent/latex-mode.tex diff --git a/test/indent/modula2.mod b/test/manual/indent/modula2.mod index f8fbcb7f4e5..f8fbcb7f4e5 100644 --- a/test/indent/modula2.mod +++ b/test/manual/indent/modula2.mod diff --git a/test/indent/nxml.xml b/test/manual/indent/nxml.xml index 61b84f270b0..61b84f270b0 100644 --- a/test/indent/nxml.xml +++ b/test/manual/indent/nxml.xml diff --git a/test/indent/octave.m b/test/manual/indent/octave.m index 4758f9933cb..4758f9933cb 100644 --- a/test/indent/octave.m +++ b/test/manual/indent/octave.m diff --git a/test/indent/pascal.pas b/test/manual/indent/pascal.pas index 2d09eb775a4..2d09eb775a4 100644 --- a/test/indent/pascal.pas +++ b/test/manual/indent/pascal.pas diff --git a/test/indent/perl.perl b/test/manual/indent/perl.perl index f86a09b2733..f86a09b2733 100755 --- a/test/indent/perl.perl +++ b/test/manual/indent/perl.perl diff --git a/test/indent/prolog.prolog b/test/manual/indent/prolog.prolog index 9ac6df1b6c7..9ac6df1b6c7 100644 --- a/test/indent/prolog.prolog +++ b/test/manual/indent/prolog.prolog diff --git a/test/indent/ps-mode.ps b/test/manual/indent/ps-mode.ps index 4b4ee0f10cb..4b4ee0f10cb 100644 --- a/test/indent/ps-mode.ps +++ b/test/manual/indent/ps-mode.ps diff --git a/test/indent/ruby.rb b/test/manual/indent/ruby.rb index b038512b114..b038512b114 100644 --- a/test/indent/ruby.rb +++ b/test/manual/indent/ruby.rb diff --git a/test/indent/scheme.scm b/test/manual/indent/scheme.scm index 84d0f6d8786..84d0f6d8786 100644 --- a/test/indent/scheme.scm +++ b/test/manual/indent/scheme.scm diff --git a/test/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss index e1ec90a5299..e1ec90a5299 100644 --- a/test/indent/scss-mode.scss +++ b/test/manual/indent/scss-mode.scss diff --git a/test/indent/sgml-mode-attribute.html b/test/manual/indent/sgml-mode-attribute.html index 4cbec0af2c6..4cbec0af2c6 100644 --- a/test/indent/sgml-mode-attribute.html +++ b/test/manual/indent/sgml-mode-attribute.html diff --git a/test/indent/shell.rc b/test/manual/indent/shell.rc index e5c63e335b9..e5c63e335b9 100755 --- a/test/indent/shell.rc +++ b/test/manual/indent/shell.rc diff --git a/test/indent/shell.sh b/test/manual/indent/shell.sh index dc184ea0d77..dc184ea0d77 100755 --- a/test/indent/shell.sh +++ b/test/manual/indent/shell.sh diff --git a/test/redisplay-testsuite.el b/test/manual/redisplay-testsuite.el index 37a5649dc1b..37a5649dc1b 100644 --- a/test/redisplay-testsuite.el +++ b/test/manual/redisplay-testsuite.el diff --git a/test/rmailmm.el b/test/manual/rmailmm.el index 96acbc4735e..96acbc4735e 100644 --- a/test/rmailmm.el +++ b/test/manual/rmailmm.el diff --git a/test/automated/finalizer-tests.el b/test/src/alloc-tests.el index 5aa35f4a2ac..97c6b4f8070 100644 --- a/test/automated/finalizer-tests.el +++ b/test/src/alloc-tests.el @@ -1,4 +1,4 @@ -;;; finalizer-tests.el --- Finalizer tests -*- lexical-binding: t -*- +;;; alloc-tests.el --- alloc tests -*- lexical-binding: t -*- ;; Copyright (C) 2015-2016 Free Software Foundation, Inc. diff --git a/test/automated/buffer-tests.el b/test/src/buffer-tests.el index 62875216a31..62875216a31 100644 --- a/test/automated/buffer-tests.el +++ b/test/src/buffer-tests.el diff --git a/test/src/callproc-tests.el b/test/src/callproc-tests.el new file mode 100644 index 00000000000..46541aba78c --- /dev/null +++ b/test/src/callproc-tests.el @@ -0,0 +1,39 @@ +;;; callproc-tests.el --- callproc.c tests -*- lexical-binding: t -*- + +;; Copyright (C) 2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(eval-when-compile (require 'cl-lib)) + +(ert-deftest initial-environment-preserved () + "Check that `initial-environment' is not modified by Emacs (Bug #10980)." + (skip-unless (eq system-type 'windows-nt)) + (cl-destructuring-bind (initial-shell shell) + (with-temp-buffer + (let ((process-environment (cons "SHELL" process-environment))) + (call-process (expand-file-name invocation-name invocation-directory) + nil t nil + "--batch" "-Q" "--eval" + (prin1-to-string + '(progn (prin1 (getenv-internal "SHELL" initial-environment)) + (prin1 (getenv-internal "SHELL")))))) + (split-string-and-unquote (buffer-string))) + (should (equal initial-shell "nil")) + (should-not (equal initial-shell shell)))) diff --git a/test/src/chartab-tests.el b/test/src/chartab-tests.el new file mode 100644 index 00000000000..016ddcdde61 --- /dev/null +++ b/test/src/chartab-tests.el @@ -0,0 +1,51 @@ +;;; chartab-tests.el --- Tests for char-tab.c + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Eli Zaretskii <eliz@gnu.org> + +;; This program 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, +;; 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) + +(defun chartab-set-and-test (rng) + (let ((tbl (make-char-table nil nil)) + (from (car rng)) + (to (cdr rng))) + (set-char-table-range tbl rng t) + (should (eq (aref tbl from) t)) + (should (eq (aref tbl to) t)) + (should (eq (aref tbl (/ (+ from to) 2)) t)) + (when (< to (max-char)) + (should-not (eq (aref tbl (1+ to)) t))) + (when (> from 0) + (should-not (eq (aref tbl (1- from)) t))))) + +(ert-deftest chartab-test-range-setting () + (mapc (lambda (elt) + (chartab-set-and-test elt)) + '((0 . 127) + (128 . 256) + (#x1000 . #x1fff) + (#x1001 . #x2000) + (#x10000 . #x20000) + (#x10001 . #x1ffff) + (#x20000 . #x30000) + (#xe0e00 . #xe0ef6) + ))) + +(provide 'chartab-tests) +;;; chartab-tests.el ends here diff --git a/test/automated/cmds-tests.el b/test/src/cmds-tests.el index 4a30d9872a1..4a30d9872a1 100644 --- a/test/automated/cmds-tests.el +++ b/test/src/cmds-tests.el diff --git a/test/automated/decoder-tests.el b/test/src/coding-tests.el index 5699fec7d17..bd494bc26f8 100644 --- a/test/automated/decoder-tests.el +++ b/test/src/coding-tests.el @@ -1,7 +1,8 @@ -;;; decoder-tests.el --- test for text decoder +;;; coding-tests.el --- tests for text encoding and decoding ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Author: Eli Zaretskii <eliz@gnu.org> ;; Author: Kenichi Handa <handa@gnu.org> ;; This file is part of GNU Emacs. @@ -24,16 +25,42 @@ (require 'ert) ;; Directory to hold test data files. -(defvar decoder-tests-workdir - (expand-file-name "decoder-tests" temporary-file-directory)) +(defvar coding-tests-workdir + (expand-file-name "coding-tests" temporary-file-directory)) ;; Remove all generated test files. -(defun decoder-tests-remove-files () - (delete-directory decoder-tests-workdir t)) +(defun coding-tests-remove-files () + (delete-directory coding-tests-workdir t)) + +(ert-deftest ert-test-coding-bogus-coding-systems () + (unwind-protect + (let (test-file) + (or (file-directory-p coding-tests-workdir) + (mkdir coding-tests-workdir t)) + (setq test-file (expand-file-name "nonexistent" coding-tests-workdir)) + (if (file-exists-p test-file) + (delete-file test-file)) + (should-error + (let ((coding-system-for-read 'bogus)) + (insert-file-contents test-file))) + ;; See bug #21602. + (setq test-file (expand-file-name "writing" coding-tests-workdir)) + (should-error + (let ((coding-system-for-write (intern "\"us-ascii\""))) + (write-region "some text" nil test-file)))) + (coding-tests-remove-files))) + +;; See issue #5251. +(ert-deftest ert-test-unibyte-buffer-dos-eol-decode () + (with-temp-buffer + (set-buffer-multibyte nil) + (insert (encode-coding-string "あ" 'euc-jp) "\xd" "\n") + (decode-coding-region (point-min) (point-max) 'euc-jp-dos) + (should-not (string-match-p "\^M" (buffer-string))))) ;; Return the contents (specified by CONTENT-TYPE; ascii, latin, or ;; binary) of a test file. -(defun decoder-tests-file-contents (content-type) +(defun coding-tests-file-contents (content-type) (let* ((ascii "ABCDEFGHIJKLMNOPQRSTUVWXYZ\n") (latin (concat ascii "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏ\n")) (binary (string-to-multibyte @@ -47,10 +74,10 @@ ;; Generate FILE with CONTENTS encoded by CODING-SYSTEM. ;; whose encoding specified by CODING-SYSTEM. -(defun decoder-tests-gen-file (file contents coding-system) - (or (file-directory-p decoder-tests-workdir) - (mkdir decoder-tests-workdir t)) - (setq file (expand-file-name file decoder-tests-workdir)) +(defun coding-tests-gen-file (file contents coding-system) + (or (file-directory-p coding-tests-workdir) + (mkdir coding-tests-workdir t)) + (setq file (expand-file-name file coding-tests-workdir)) (with-temp-file file (set-buffer-file-coding-system coding-system) (insert contents)) @@ -60,7 +87,7 @@ ;;; file. ;; Convert all LFs to CR LF sequences in the string STR. -(defun decoder-tests-lf-to-crlf (str) +(defun coding-tests-lf-to-crlf (str) (with-temp-buffer (insert str) (goto-char (point-min)) @@ -70,14 +97,14 @@ (buffer-string))) ;; Convert all LFs to CRs in the string STR. -(defun decoder-tests-lf-to-cr (str) +(defun coding-tests-lf-to-cr (str) (with-temp-buffer (insert str) (subst-char-in-region (point-min) (point-max) ?\n ?\r) (buffer-string))) ;; Convert all LFs to LF LF sequences in the string STR. -(defun decoder-tests-lf-to-lflf (str) +(defun coding-tests-lf-to-lflf (str) (with-temp-buffer (insert str) (goto-char (point-min)) @@ -86,27 +113,27 @@ (buffer-string))) ;; Prepend the UTF-8 BOM to STR. -(defun decoder-tests-add-bom (str) +(defun coding-tests-add-bom (str) (concat "\xfeff" str)) ;; Return the name of test file whose contents specified by ;; CONTENT-TYPE and whose encoding specified by CODING-SYSTEM. -(defun decoder-tests-filename (content-type coding-system &optional ext) +(defun coding-tests-filename (content-type coding-system &optional ext) (if ext (expand-file-name (format "%s-%s.%s" content-type coding-system ext) - decoder-tests-workdir) + coding-tests-workdir) (expand-file-name (format "%s-%s" content-type coding-system) - decoder-tests-workdir))) + coding-tests-workdir))) ;;; Check ASCII optimizing decoder ;; Generate a test file whose contents specified by CONTENT-TYPE and ;; whose encoding specified by CODING-SYSTEM. -(defun decoder-tests-ao-gen-file (content-type coding-system) - (let ((file (decoder-tests-filename content-type coding-system))) - (decoder-tests-gen-file file - (decoder-tests-file-contents content-type) +(defun coding-tests-ao-gen-file (content-type coding-system) + (let ((file (coding-tests-filename content-type coding-system))) + (coding-tests-gen-file file + (coding-tests-file-contents content-type) coding-system))) ;; Test the decoding of a file whose contents and encoding are @@ -118,13 +145,13 @@ ;; instance, when a file of dos eol-type is read by unix eol-type, ;; `decode-test-lf-to-crlf' must be specified. -(defun decoder-tests (content-type write-coding read-coding detected-coding +(defun coding-tests (content-type write-coding read-coding detected-coding &optional translator) (prefer-coding-system 'utf-8-auto) - (let ((filename (decoder-tests-filename content-type write-coding))) + (let ((filename (coding-tests-filename content-type write-coding))) (with-temp-buffer (let ((coding-system-for-read read-coding) - (contents (decoder-tests-file-contents content-type)) + (contents (coding-tests-file-contents content-type)) (disable-ascii-optimization nil)) (if translator (setq contents (funcall translator contents))) @@ -136,75 +163,75 @@ (string-to-list (buffer-string)) (string-to-list contents))))))) -(ert-deftest ert-test-decoder-ascii () +(ert-deftest ert-test-coding-ascii () (unwind-protect (progn (dolist (eol-type '(unix dos mac)) - (decoder-tests-ao-gen-file 'ascii eol-type)) - (should-not (decoder-tests 'ascii 'unix 'undecided 'unix)) - (should-not (decoder-tests 'ascii 'dos 'undecided 'dos)) - (should-not (decoder-tests 'ascii 'dos 'dos 'dos)) - (should-not (decoder-tests 'ascii 'mac 'undecided 'mac)) - (should-not (decoder-tests 'ascii 'mac 'mac 'mac)) - (should-not (decoder-tests 'ascii 'dos 'utf-8 'utf-8-dos)) - (should-not (decoder-tests 'ascii 'dos 'unix 'unix - 'decoder-tests-lf-to-crlf)) - (should-not (decoder-tests 'ascii 'mac 'dos 'dos - 'decoder-tests-lf-to-cr)) - (should-not (decoder-tests 'ascii 'dos 'mac 'mac - 'decoder-tests-lf-to-lflf))) - (decoder-tests-remove-files))) - -(ert-deftest ert-test-decoder-latin () + (coding-tests-ao-gen-file 'ascii eol-type)) + (should-not (coding-tests 'ascii 'unix 'undecided 'unix)) + (should-not (coding-tests 'ascii 'dos 'undecided 'dos)) + (should-not (coding-tests 'ascii 'dos 'dos 'dos)) + (should-not (coding-tests 'ascii 'mac 'undecided 'mac)) + (should-not (coding-tests 'ascii 'mac 'mac 'mac)) + (should-not (coding-tests 'ascii 'dos 'utf-8 'utf-8-dos)) + (should-not (coding-tests 'ascii 'dos 'unix 'unix + 'coding-tests-lf-to-crlf)) + (should-not (coding-tests 'ascii 'mac 'dos 'dos + 'coding-tests-lf-to-cr)) + (should-not (coding-tests 'ascii 'dos 'mac 'mac + 'coding-tests-lf-to-lflf))) + (coding-tests-remove-files))) + +(ert-deftest ert-test-coding-latin () (unwind-protect (progn (dolist (coding '("utf-8" "utf-8-with-signature")) (dolist (eol-type '("unix" "dos" "mac")) - (decoder-tests-ao-gen-file 'latin + (coding-tests-ao-gen-file 'latin (intern (concat coding "-" eol-type))))) - (should-not (decoder-tests 'latin 'utf-8-unix 'undecided 'utf-8-unix)) - (should-not (decoder-tests 'latin 'utf-8-unix 'utf-8-unix 'utf-8-unix)) - (should-not (decoder-tests 'latin 'utf-8-dos 'undecided 'utf-8-dos)) - (should-not (decoder-tests 'latin 'utf-8-dos 'utf-8-dos 'utf-8-dos)) - (should-not (decoder-tests 'latin 'utf-8-mac 'undecided 'utf-8-mac)) - (should-not (decoder-tests 'latin 'utf-8-mac 'utf-8-mac 'utf-8-mac)) - (should-not (decoder-tests 'latin 'utf-8-dos 'unix 'utf-8-unix - 'decoder-tests-lf-to-crlf)) - (should-not (decoder-tests 'latin 'utf-8-mac 'dos 'utf-8-dos - 'decoder-tests-lf-to-cr)) - (should-not (decoder-tests 'latin 'utf-8-dos 'mac 'utf-8-mac - 'decoder-tests-lf-to-lflf)) - (should-not (decoder-tests 'latin 'utf-8-with-signature-unix 'undecided + (should-not (coding-tests 'latin 'utf-8-unix 'undecided 'utf-8-unix)) + (should-not (coding-tests 'latin 'utf-8-unix 'utf-8-unix 'utf-8-unix)) + (should-not (coding-tests 'latin 'utf-8-dos 'undecided 'utf-8-dos)) + (should-not (coding-tests 'latin 'utf-8-dos 'utf-8-dos 'utf-8-dos)) + (should-not (coding-tests 'latin 'utf-8-mac 'undecided 'utf-8-mac)) + (should-not (coding-tests 'latin 'utf-8-mac 'utf-8-mac 'utf-8-mac)) + (should-not (coding-tests 'latin 'utf-8-dos 'unix 'utf-8-unix + 'coding-tests-lf-to-crlf)) + (should-not (coding-tests 'latin 'utf-8-mac 'dos 'utf-8-dos + 'coding-tests-lf-to-cr)) + (should-not (coding-tests 'latin 'utf-8-dos 'mac 'utf-8-mac + 'coding-tests-lf-to-lflf)) + (should-not (coding-tests 'latin 'utf-8-with-signature-unix 'undecided 'utf-8-with-signature-unix)) - (should-not (decoder-tests 'latin 'utf-8-with-signature-unix 'utf-8-auto + (should-not (coding-tests 'latin 'utf-8-with-signature-unix 'utf-8-auto 'utf-8-with-signature-unix)) - (should-not (decoder-tests 'latin 'utf-8-with-signature-dos 'undecided + (should-not (coding-tests 'latin 'utf-8-with-signature-dos 'undecided 'utf-8-with-signature-dos)) - (should-not (decoder-tests 'latin 'utf-8-with-signature-unix 'utf-8 - 'utf-8-unix 'decoder-tests-add-bom)) - (should-not (decoder-tests 'latin 'utf-8-with-signature-unix 'utf-8 - 'utf-8-unix 'decoder-tests-add-bom))) - (decoder-tests-remove-files))) + (should-not (coding-tests 'latin 'utf-8-with-signature-unix 'utf-8 + 'utf-8-unix 'coding-tests-add-bom)) + (should-not (coding-tests 'latin 'utf-8-with-signature-unix 'utf-8 + 'utf-8-unix 'coding-tests-add-bom))) + (coding-tests-remove-files))) -(ert-deftest ert-test-decoder-binary () +(ert-deftest ert-test-coding-binary () (unwind-protect (progn (dolist (eol-type '("unix" "dos" "mac")) - (decoder-tests-ao-gen-file 'binary + (coding-tests-ao-gen-file 'binary (intern (concat "raw-text" "-" eol-type)))) - (should-not (decoder-tests 'binary 'raw-text-unix 'undecided + (should-not (coding-tests 'binary 'raw-text-unix 'undecided 'raw-text-unix)) - (should-not (decoder-tests 'binary 'raw-text-dos 'undecided + (should-not (coding-tests 'binary 'raw-text-dos 'undecided 'raw-text-dos)) - (should-not (decoder-tests 'binary 'raw-text-mac 'undecided + (should-not (coding-tests 'binary 'raw-text-mac 'undecided 'raw-text-mac)) - (should-not (decoder-tests 'binary 'raw-text-dos 'unix - 'raw-text-unix 'decoder-tests-lf-to-crlf)) - (should-not (decoder-tests 'binary 'raw-text-mac 'dos - 'raw-text-dos 'decoder-tests-lf-to-cr)) - (should-not (decoder-tests 'binary 'raw-text-dos 'mac - 'raw-text-mac 'decoder-tests-lf-to-lflf))) - (decoder-tests-remove-files))) + (should-not (coding-tests 'binary 'raw-text-dos 'unix + 'raw-text-unix 'coding-tests-lf-to-crlf)) + (should-not (coding-tests 'binary 'raw-text-mac 'dos + 'raw-text-dos 'coding-tests-lf-to-cr)) + (should-not (coding-tests 'binary 'raw-text-dos 'mac + 'raw-text-mac 'coding-tests-lf-to-lflf))) + (coding-tests-remove-files))) ;;; Check the coding system `prefer-utf-8'. @@ -212,7 +239,7 @@ ;; Read FILE. Check if the encoding was detected as DETECT. If ;; PREFER is non-nil, prefer that coding system before reading. -(defun decoder-tests-prefer-utf-8-read (file detect prefer) +(defun coding-tests-prefer-utf-8-read (file detect prefer) (with-temp-buffer (with-coding-priority (if prefer (list prefer)) (insert-file-contents file)) @@ -225,7 +252,7 @@ ;; coding tag with it before writing. If STR is non-nil, insert it ;; before writing. -(defun decoder-tests-prefer-utf-8-write (file coding-tag coding +(defun coding-tests-prefer-utf-8-write (file coding-tag coding &optional str) (with-temp-buffer (insert-file-contents file) @@ -235,34 +262,34 @@ (insert ";;\n")) (if str (insert str)) - (write-file (decoder-tests-filename 'test 'test "el")) + (write-file (coding-tests-filename 'test 'test "el")) (if (coding-system-equal buffer-file-coding-system coding) nil (format "Incorrect encoding: %s" last-coding-system-used)))) -(ert-deftest ert-test-decoder-prefer-utf-8 () +(ert-deftest ert-test-coding-prefer-utf-8 () (unwind-protect - (let ((ascii (decoder-tests-gen-file "ascii.el" - (decoder-tests-file-contents 'ascii) + (let ((ascii (coding-tests-gen-file "ascii.el" + (coding-tests-file-contents 'ascii) 'unix)) - (latin (decoder-tests-gen-file "utf-8.el" - (decoder-tests-file-contents 'latin) + (latin (coding-tests-gen-file "utf-8.el" + (coding-tests-file-contents 'latin) 'utf-8-unix))) - (should-not (decoder-tests-prefer-utf-8-read + (should-not (coding-tests-prefer-utf-8-read ascii 'prefer-utf-8-unix nil)) - (should-not (decoder-tests-prefer-utf-8-read + (should-not (coding-tests-prefer-utf-8-read latin 'utf-8-unix nil)) - (should-not (decoder-tests-prefer-utf-8-read + (should-not (coding-tests-prefer-utf-8-read latin 'utf-8-unix 'iso-8859-1)) - (should-not (decoder-tests-prefer-utf-8-read + (should-not (coding-tests-prefer-utf-8-read latin 'utf-8-unix 'sjis)) - (should-not (decoder-tests-prefer-utf-8-write + (should-not (coding-tests-prefer-utf-8-write ascii nil 'prefer-utf-8-unix)) - (should-not (decoder-tests-prefer-utf-8-write + (should-not (coding-tests-prefer-utf-8-write ascii 'iso-8859-1 'iso-8859-1-unix)) - (should-not (decoder-tests-prefer-utf-8-write + (should-not (coding-tests-prefer-utf-8-write ascii nil 'utf-8-unix "À"))) - (decoder-tests-remove-files))) + (coding-tests-remove-files))) ;;; The following is for benchmark testing of the new optimized @@ -347,3 +374,10 @@ (result (benchmark-run 10 (with-temp-buffer (insert-file-contents (car file)))))) (insert (format "%s: %s\n" (car file) result))))))) + +;; Local Variables: +;; byte-compile-warnings: (not obsolete) +;; End: + +(provide 'coding-tests) +;; coding-tests.el ends here diff --git a/test/src/data-tests.el b/test/src/data-tests.el new file mode 100644 index 00000000000..757522e399b --- /dev/null +++ b/test/src/data-tests.el @@ -0,0 +1,452 @@ +;;; data-tests.el --- tests for src/data.c + +;; Copyright (C) 2013-2016 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'cl-lib) +(eval-when-compile (require 'cl)) + +(ert-deftest data-tests-= () + (should-error (=)) + (should (= 1)) + (should (= 2 2)) + (should (= 9 9 9 9 9 9 9 9 9)) + (should-not (apply #'= '(3 8 3))) + (should-error (= 9 9 'foo)) + ;; Short circuits before getting to bad arg + (should-not (= 9 8 'foo))) + +(ert-deftest data-tests-< () + (should-error (<)) + (should (< 1)) + (should (< 2 3)) + (should (< -6 -1 0 2 3 4 8 9 999)) + (should-not (apply #'< '(3 8 3))) + (should-error (< 9 10 'foo)) + ;; Short circuits before getting to bad arg + (should-not (< 9 8 'foo))) + +(ert-deftest data-tests-> () + (should-error (>)) + (should (> 1)) + (should (> 3 2)) + (should (> 6 1 0 -2 -3 -4 -8 -9 -999)) + (should-not (apply #'> '(3 8 3))) + (should-error (> 9 8 'foo)) + ;; Short circuits before getting to bad arg + (should-not (> 8 9 'foo))) + +(ert-deftest data-tests-<= () + (should-error (<=)) + (should (<= 1)) + (should (<= 2 3)) + (should (<= -6 -1 -1 0 0 0 2 3 4 8 999)) + (should-not (apply #'<= '(3 8 3 3))) + (should-error (<= 9 10 'foo)) + ;; Short circuits before getting to bad arg + (should-not (<= 9 8 'foo))) + +(ert-deftest data-tests->= () + (should-error (>=)) + (should (>= 1)) + (should (>= 3 2)) + (should (>= 666 1 0 0 -2 -3 -3 -3 -4 -8 -8 -9 -999)) + (should-not (apply #'>= '(3 8 3))) + (should-error (>= 9 8 'foo)) + ;; Short circuits before getting to bad arg + (should-not (>= 8 9 'foo))) + +;; Bool vector tests. Compactly represent bool vectors as hex +;; strings. + +(ert-deftest bool-vector-count-population-all-0-nil () + (cl-loop for sz in '(0 45 1 64 9 344) + do (let* ((bv (make-bool-vector sz nil))) + (should + (zerop + (bool-vector-count-population bv)))))) + +(ert-deftest bool-vector-count-population-all-1-t () + (cl-loop for sz in '(0 45 1 64 9 344) + do (let* ((bv (make-bool-vector sz t))) + (should + (eql + (bool-vector-count-population bv) + sz))))) + +(ert-deftest bool-vector-count-population-1-nil () + (let* ((bv (make-bool-vector 45 nil))) + (aset bv 40 t) + (aset bv 0 t) + (should + (eql + (bool-vector-count-population bv) + 2)))) + +(ert-deftest bool-vector-count-population-1-t () + (let* ((bv (make-bool-vector 45 t))) + (aset bv 40 nil) + (aset bv 0 nil) + (should + (eql + (bool-vector-count-population bv) + 43)))) + +(defun mock-bool-vector-count-consecutive (a b i) + (loop for i from i below (length a) + while (eq (aref a i) b) + sum 1)) + +(defun test-bool-vector-bv-from-hex-string (desc) + (let (bv nchars nibbles) + (dolist (c (string-to-list desc)) + (push (string-to-number + (char-to-string c) + 16) + nibbles)) + (setf bv (make-bool-vector (* 4 (length nibbles)) nil)) + (let ((i 0)) + (dolist (n (nreverse nibbles)) + (dotimes (_ 4) + (aset bv i (> (logand 1 n) 0)) + (incf i) + (setf n (lsh n -1))))) + bv)) + +(defun test-bool-vector-to-hex-string (bv) + (let (nibbles (v (cl-coerce bv 'list))) + (while v + (push (logior + (lsh (if (nth 0 v) 1 0) 0) + (lsh (if (nth 1 v) 1 0) 1) + (lsh (if (nth 2 v) 1 0) 2) + (lsh (if (nth 3 v) 1 0) 3)) + nibbles) + (setf v (nthcdr 4 v))) + (mapconcat (lambda (n) (format "%X" n)) + (nreverse nibbles) + ""))) + +(defun test-bool-vector-count-consecutive-tc (desc) + "Run a test case for bool-vector-count-consecutive. +DESC is a string describing the test. It is a sequence of +hexadecimal digits describing the bool vector. We exhaustively +test all counts at all possible positions in the vector by +comparing the subr with a much slower lisp implementation." + (let ((bv (test-bool-vector-bv-from-hex-string desc))) + (loop + for lf in '(nil t) + do (loop + for pos from 0 upto (length bv) + for cnt = (mock-bool-vector-count-consecutive bv lf pos) + for rcnt = (bool-vector-count-consecutive bv lf pos) + unless (eql cnt rcnt) + do (error "FAILED testcase %S %3S %3S %3S" + pos lf cnt rcnt))))) + +(defconst bool-vector-test-vectors +'("" + "0" + "F" + "0F" + "F0" + "00000000000000000000000000000FFFFF0000000" + "44a50234053fba3340000023444a50234053fba33400000234" + "12341234123456123412346001234123412345612341234600" + "44a50234053fba33400000234" + "1234123412345612341234600" + "44a50234053fba33400000234" + "1234123412345612341234600" + "44a502340" + "123412341" + "0000000000000000000000000" + "FFFFFFFFFFFFFFFF1")) + +(ert-deftest bool-vector-count-consecutive () + (mapc #'test-bool-vector-count-consecutive-tc + bool-vector-test-vectors)) + +(defun test-bool-vector-apply-mock-op (mock a b c) + "Compute (slowly) the correct result of a bool-vector set operation." + (let (changed nv) + (assert (eql (length b) (length c))) + (if a (setf nv a) + (setf a (make-bool-vector (length b) nil)) + (setf changed t)) + + (loop for i below (length b) + for mockr = (funcall mock + (if (aref b i) 1 0) + (if (aref c i) 1 0)) + for r = (not (= 0 mockr)) + do (progn + (unless (eq (aref a i) r) + (setf changed t)) + (setf (aref a i) r))) + (if changed a))) + +(defun test-bool-vector-binop (mock real) + "Test a binary set operation." + (loop for s1 in bool-vector-test-vectors + for bv1 = (test-bool-vector-bv-from-hex-string s1) + for vecs2 = (cl-remove-if-not + (lambda (x) (eql (length x) (length s1))) + bool-vector-test-vectors) + do (loop for s2 in vecs2 + for bv2 = (test-bool-vector-bv-from-hex-string s2) + for mock-result = (test-bool-vector-apply-mock-op + mock nil bv1 bv2) + for real-result = (funcall real bv1 bv2) + do (progn + (should (equal mock-result real-result)))))) + +(ert-deftest bool-vector-intersection-op () + (test-bool-vector-binop + #'logand + #'bool-vector-intersection)) + +(ert-deftest bool-vector-union-op () + (test-bool-vector-binop + #'logior + #'bool-vector-union)) + +(ert-deftest bool-vector-xor-op () + (test-bool-vector-binop + #'logxor + #'bool-vector-exclusive-or)) + +(ert-deftest bool-vector-set-difference-op () + (test-bool-vector-binop + (lambda (a b) (logand a (lognot b))) + #'bool-vector-set-difference)) + +(ert-deftest bool-vector-change-detection () + (let* ((vc1 (test-bool-vector-bv-from-hex-string "abcdef")) + (vc2 (test-bool-vector-bv-from-hex-string "012345")) + (vc3 (make-bool-vector (length vc1) nil)) + (c1 (bool-vector-union vc1 vc2 vc3)) + (c2 (bool-vector-union vc1 vc2 vc3))) + (should (equal c1 (test-bool-vector-apply-mock-op + #'logior + nil + vc1 vc2))) + (should (not c2)))) + +(ert-deftest bool-vector-not () + (let* ((v1 (test-bool-vector-bv-from-hex-string "FFFF3")) + (v2 (test-bool-vector-bv-from-hex-string "0000C")) + (v3 (bool-vector-not v1))) + (should (equal v2 v3)))) + +;; Tests for variable bindings + +(defvar binding-test-buffer-A (get-buffer-create "A")) +(defvar binding-test-buffer-B (get-buffer-create "B")) + +(defvar binding-test-always-local 'always) +(make-variable-buffer-local 'binding-test-always-local) + +(defvar binding-test-some-local 'some) +(with-current-buffer binding-test-buffer-A + (set (make-local-variable 'binding-test-some-local) 'local)) + +(ert-deftest binding-test-manual () + "A test case from the elisp manual." + (save-excursion + (set-buffer binding-test-buffer-A) + (let ((binding-test-some-local 'something-else)) + (should (eq binding-test-some-local 'something-else)) + (set-buffer binding-test-buffer-B) + (should (eq binding-test-some-local 'some))) + (should (eq binding-test-some-local 'some)) + (set-buffer binding-test-buffer-A) + (should (eq binding-test-some-local 'local)))) + +(ert-deftest binding-test-setq-default () + "Test that a setq-default has no effect when there is a local binding." + (save-excursion + (set-buffer binding-test-buffer-B) + ;; This variable is not local in this buffer. + (let ((binding-test-some-local 'something-else)) + (setq-default binding-test-some-local 'new-default)) + (should (eq binding-test-some-local 'some)))) + +(ert-deftest binding-test-makunbound () + "Tests of makunbound, from the manual." + (save-excursion + (set-buffer binding-test-buffer-B) + (should (boundp 'binding-test-some-local)) + (let ((binding-test-some-local 'outer)) + (let ((binding-test-some-local 'inner)) + (makunbound 'binding-test-some-local) + (should (not (boundp 'binding-test-some-local)))) + (should (and (boundp 'binding-test-some-local) + (eq binding-test-some-local 'outer)))))) + +(ert-deftest binding-test-defvar-bool () + "Test DEFVAR_BOOL" + (let ((display-hourglass 5)) + (should (eq display-hourglass t)))) + +(ert-deftest binding-test-defvar-int () + "Test DEFVAR_INT" + (should-error (setq gc-cons-threshold 5.0) :type 'wrong-type-argument)) + +(ert-deftest binding-test-set-constant-t () + "Test setting the constant t" + (should-error (setq t 'bob) :type 'setting-constant)) + +(ert-deftest binding-test-set-constant-nil () + "Test setting the constant nil" + (should-error (setq nil 'bob) :type 'setting-constant)) + +(ert-deftest binding-test-set-constant-keyword () + "Test setting a keyword constant" + (should-error (setq :keyword 'bob) :type 'setting-constant)) + +(ert-deftest binding-test-set-constant-nil () + "Test setting a keyword to itself" + (should (setq :keyword :keyword))) + +;; More tests to write - +;; kill-local-variable +;; defconst; can modify +;; defvar and defconst modify the local binding [ doesn't matter for us ] +;; various kinds of special internal forwarding objects +;; a couple examples in manual, not enough +;; variable aliases + +;; Tests for watchpoints + +(ert-deftest data-tests-variable-watchers () + (defvar data-tests-var 0) + (let* ((watch-data nil) + (collect-watch-data + (lambda (&rest args) (push args watch-data)))) + (cl-flet ((should-have-watch-data (data) + (should (equal (pop watch-data) data)) + (should (null watch-data)))) + (add-variable-watcher 'data-tests-var collect-watch-data) + (setq data-tests-var 1) + (should-have-watch-data '(data-tests-var 1 set nil)) + (let ((data-tests-var 2)) + (should-have-watch-data '(data-tests-var 2 let nil)) + (setq data-tests-var 3) + (should-have-watch-data '(data-tests-var 3 set nil))) + (should-have-watch-data '(data-tests-var 1 unlet nil)) + ;; `setq-default' on non-local variable is same as `setq'. + (setq-default data-tests-var 4) + (should-have-watch-data '(data-tests-var 4 set nil)) + (makunbound 'data-tests-var) + (should-have-watch-data '(data-tests-var nil makunbound nil)) + (setq data-tests-var 5) + (should-have-watch-data '(data-tests-var 5 set nil)) + (remove-variable-watcher 'data-tests-var collect-watch-data) + (setq data-tests-var 6) + (should (null watch-data))))) + +(ert-deftest data-tests-varalias-watchers () + (defvar data-tests-var0 0) + (defvar data-tests-var1 0) + (defvar data-tests-var2 0) + (defvar data-tests-var3 0) + (let* ((watch-data nil) + (collect-watch-data + (lambda (&rest args) (push args watch-data)))) + (cl-flet ((should-have-watch-data (data) + (should (equal (pop watch-data) data)) + (should (null watch-data)))) + ;; Watch var0, then alias it. + (add-variable-watcher 'data-tests-var0 collect-watch-data) + (defvaralias 'data-tests-var0-alias 'data-tests-var0) + (setq data-tests-var0 1) + (should-have-watch-data '(data-tests-var0 1 set nil)) + (setq data-tests-var0-alias 2) + (should-have-watch-data '(data-tests-var0 2 set nil)) + ;; Alias var1, then watch var1-alias. + (defvaralias 'data-tests-var1-alias 'data-tests-var1) + (add-variable-watcher 'data-tests-var1-alias collect-watch-data) + (setq data-tests-var1 1) + (should-have-watch-data '(data-tests-var1 1 set nil)) + (setq data-tests-var1-alias 2) + (should-have-watch-data '(data-tests-var1 2 set nil)) + ;; Alias var2, then watch it. + (defvaralias 'data-tests-var2-alias 'data-tests-var2) + (add-variable-watcher 'data-tests-var2 collect-watch-data) + (setq data-tests-var2 1) + (should-have-watch-data '(data-tests-var2 1 set nil)) + (setq data-tests-var2-alias 2) + (should-have-watch-data '(data-tests-var2 2 set nil)) + ;; Watch var3-alias, then make it alias var3 (this removes the + ;; watcher flag). + (defvar data-tests-var3-alias 0) + (add-variable-watcher 'data-tests-var3-alias collect-watch-data) + (defvaralias 'data-tests-var3-alias 'data-tests-var3) + (should-have-watch-data '(data-tests-var3-alias + data-tests-var3 defvaralias nil)) + (setq data-tests-var3 1) + (setq data-tests-var3-alias 2) + (should (null watch-data))))) + +(ert-deftest data-tests-local-variable-watchers () + (defvar-local data-tests-lvar 0) + (let* ((buf1 (current-buffer)) + (buf2 nil) + (watch-data nil) + (collect-watch-data + (lambda (&rest args) (push args watch-data)))) + (cl-flet ((should-have-watch-data (data) + (should (equal (pop watch-data) data)) + (should (null watch-data)))) + (add-variable-watcher 'data-tests-lvar collect-watch-data) + (setq data-tests-lvar 1) + (should-have-watch-data `(data-tests-lvar 1 set ,buf1)) + (let ((data-tests-lvar 2)) + (should-have-watch-data `(data-tests-lvar 2 let ,buf1)) + (setq data-tests-lvar 3) + (should-have-watch-data `(data-tests-lvar 3 set ,buf1))) + (should-have-watch-data `(data-tests-lvar 1 unlet ,buf1)) + (setq-default data-tests-lvar 4) + (should-have-watch-data `(data-tests-lvar 4 set nil)) + (with-temp-buffer + (setq buf2 (current-buffer)) + (setq data-tests-lvar 1) + (should-have-watch-data `(data-tests-lvar 1 set ,buf2)) + (let ((data-tests-lvar 2)) + (should-have-watch-data `(data-tests-lvar 2 let ,buf2)) + (setq data-tests-lvar 3) + (should-have-watch-data `(data-tests-lvar 3 set ,buf2))) + (should-have-watch-data `(data-tests-lvar 1 unlet ,buf2)) + (kill-local-variable 'data-tests-lvar) + (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2)) + (setq data-tests-lvar 3.5) + (should-have-watch-data `(data-tests-lvar 3.5 set ,buf2)) + (kill-all-local-variables) + (should-have-watch-data `(data-tests-lvar nil makunbound ,buf2))) + (setq-default data-tests-lvar 4) + (should-have-watch-data `(data-tests-lvar 4 set nil)) + (makunbound 'data-tests-lvar) + (should-have-watch-data '(data-tests-lvar nil makunbound nil)) + (setq data-tests-lvar 5) + (should-have-watch-data `(data-tests-lvar 5 set ,buf1)) + (remove-variable-watcher 'data-tests-lvar collect-watch-data) + (setq data-tests-lvar 6) + (should (null watch-data))))) diff --git a/test/automated/zlib-tests.el b/test/src/decompress-tests.el index 7ece58d97c9..f0264ec548d 100644 --- a/test/automated/zlib-tests.el +++ b/test/src/decompress-tests.el @@ -1,4 +1,4 @@ -;;; zlib-tests.el --- Test suite for zlib. +;;; decompress-tests.el --- Test suite for decompress. ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. @@ -40,6 +40,6 @@ (buffer-string)) "foo\n")))) -(provide 'zlib-tests) +(provide 'decompress-tests) -;;; zlib-tests.el ends here. +;;; decompress-tests.el ends here. diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el new file mode 100644 index 00000000000..be490545747 --- /dev/null +++ b/test/src/doc-tests.el @@ -0,0 +1,92 @@ +;;; doc-tests.el --- Tests for doc.c + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Eli Zaretskii <eliz@gnu.org> + +;; This program 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, +;; 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) + +(ert-deftest doc-test-substitute-command-keys () + ;; Bindings. + (should (string= (substitute-command-keys "foo \\[goto-char]") "foo M-g c")) + ;; Cannot use string= here, as that compares unibyte and multibyte + ;; strings not equal. + (should (compare-strings + (substitute-command-keys "\200 \\[goto-char]") nil nil + "\200 M-g c" nil nil)) + ;; Literals. + (should (string= (substitute-command-keys "foo \\=\\[goto-char]") + "foo \\[goto-char]")) + (should (string= (substitute-command-keys "foo \\=\\=") + "foo \\=")) + ;; Keymaps. + (should (string= (substitute-command-keys + "\\{minibuffer-local-must-match-map}") + "\ +key binding +--- ------- + +C-g abort-recursive-edit +TAB minibuffer-complete +C-j minibuffer-complete-and-exit +RET minibuffer-complete-and-exit +ESC Prefix Command +SPC minibuffer-complete-word +? minibuffer-completion-help +<C-tab> file-cache-minibuffer-complete +<XF86Back> previous-history-element +<XF86Forward> next-history-element +<down> next-line-or-history-element +<next> next-history-element +<prior> switch-to-completions +<up> previous-line-or-history-element + +M-v switch-to-completions + +M-n next-history-element +M-p previous-history-element +M-r previous-matching-history-element +M-s next-matching-history-element + +")) + (should (string= + (substitute-command-keys + "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]") + "C-g")) + ;; Allow any style of quotes, since the terminal might not support + ;; UTF-8. + (should (string-match + "\nUses keymap [`‘']foobar-map['’], which is not currently defined.\n" + (substitute-command-keys "\\{foobar-map}"))) + ;; Quotes. + (should (let ((text-quoting-style 'grave)) + (string= (substitute-command-keys "quotes `like this'") + "quotes `like this'"))) + (should (let ((text-quoting-style 'grave)) + (string= (substitute-command-keys "quotes ‘like this’") + "quotes ‘like this’"))) + (should (let ((text-quoting-style 'straight)) + (string= (substitute-command-keys "quotes `like this'") + "quotes 'like this'"))) + ;; Bugs. + (should (string= (substitute-command-keys "\\[foobar") "\\[foobar")) + (should (string= (substitute-command-keys "\\=") "\\=")) + ) + +(provide 'doc-tests) +;;; doc-tests.el ends here diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el new file mode 100644 index 00000000000..2f90d1e7495 --- /dev/null +++ b/test/src/editfns-tests.el @@ -0,0 +1,136 @@ +;;; editfns-tests.el -- tests for editfns.c + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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, +;; 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) + +(ert-deftest format-properties () + ;; Bug #23730 + (should (ert-equal-including-properties + (format (propertize "%d" 'face '(:background "red")) 1) + #("1" 0 1 (face (:background "red"))))) + (should (ert-equal-including-properties + (format (propertize "%2d" 'face '(:background "red")) 1) + #(" 1" 0 2 (face (:background "red"))))) + (should (ert-equal-including-properties + (format (propertize "%02d" 'face '(:background "red")) 1) + #("01" 0 2 (face (:background "red"))))) + (should (ert-equal-including-properties + (format (concat (propertize "%2d" 'x 'X) + (propertize "a" 'a 'A) + (propertize "b" 'b 'B)) + 1) + #(" 1ab" 0 2 (x X) 2 3 (a A) 3 4 (b B)))) + + ;; Bug #5306 + (should (ert-equal-including-properties + (format "%.10s" + (concat "1234567890aaaa" + (propertize "12345678901234567890" 'xxx 25))) + "1234567890")) + (should (ert-equal-including-properties + (format "%.10s" + (concat "123456789" + (propertize "12345678901234567890" 'xxx 25))) + #("1234567891" 9 10 (xxx 25)))) + + ;; Bug #23859 + (should (ert-equal-including-properties + (format "%4s" (propertize "hi" 'face 'bold)) + #(" hi" 2 4 (face bold)))) + + ;; Bug #23897 + (should (ert-equal-including-properties + (format "%s" (concat (propertize "01234" 'face 'bold) "56789")) + #("0123456789" 0 5 (face bold)))) + (should (ert-equal-including-properties + (format "%s" (concat (propertize "01" 'face 'bold) + (propertize "23" 'face 'underline) + "45")) + #("012345" 0 2 (face bold) 2 4 (face underline)))) + ;; The last property range is extended to include padding on the + ;; right, but the first range is not extended to the left to include + ;; padding on the left! + (should (ert-equal-including-properties + (format "%12s" (concat (propertize "01234" 'face 'bold) "56789")) + #(" 0123456789" 2 7 (face bold)))) + (should (ert-equal-including-properties + (format "%-12s" (concat (propertize "01234" 'face 'bold) "56789")) + #("0123456789 " 0 5 (face bold)))) + (should (ert-equal-including-properties + (format "%10s" (concat (propertize "01" 'face 'bold) + (propertize "23" 'face 'underline) + "45")) + #(" 012345" 4 6 (face bold) 6 8 (face underline)))) + (should (ert-equal-including-properties + (format "%-10s" (concat (propertize "01" 'face 'bold) + (propertize "23" 'face 'underline) + "45")) + #("012345 " 0 2 (face bold) 2 4 (face underline)))) + (should (ert-equal-including-properties + (format "%-10s" (concat (propertize "01" 'face 'bold) + (propertize "23" 'face 'underline) + (propertize "45" 'face 'italic))) + #("012345 " 0 2 (face bold) 2 4 (face underline) 4 10 (face italic))))) + +;; Tests for bug#5131. +(defun transpose-test-reverse-word (start end) + "Reverse characters in a word by transposing pairs of characters." + (let ((begm (make-marker)) + (endm (make-marker))) + (set-marker begm start) + (set-marker endm end) + (while (> endm begm) + (progn (transpose-regions begm (1+ begm) endm (1+ endm) t) + (set-marker begm (1+ begm)) + (set-marker endm (1- endm)))))) + +(defun transpose-test-get-byte-positions (len) + "Validate character position to byte position translation." + (let ((bytes '())) + (dotimes (pos len) + (setq bytes (add-to-list 'bytes (position-bytes (1+ pos)) t))) + bytes)) + +(ert-deftest transpose-ascii-regions-test () + (with-temp-buffer + (erase-buffer) + (insert "abcd") + (transpose-test-reverse-word 1 4) + (should (string= (buffer-string) "dcba")) + (should (equal (transpose-test-get-byte-positions 5) '(1 2 3 4 5))))) + +(ert-deftest transpose-nonascii-regions-test-1 () + (with-temp-buffer + (erase-buffer) + (insert "÷bcd") + (transpose-test-reverse-word 1 4) + (should (string= (buffer-string) "dcb÷")) + (should (equal (transpose-test-get-byte-positions 5) '(1 2 3 4 6))))) + +(ert-deftest transpose-nonascii-regions-test-2 () + (with-temp-buffer + (erase-buffer) + (insert "÷ab\"äé") + (transpose-test-reverse-word 1 6) + (should (string= (buffer-string) "éä\"ba÷")) + (should (equal (transpose-test-get-byte-positions 7) '(1 3 5 6 7 8 10))))) + +;;; editfns-tests.el ends here diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el new file mode 100644 index 00000000000..fe08506ed25 --- /dev/null +++ b/test/src/eval-tests.el @@ -0,0 +1,50 @@ +;;; eval-tests.el --- unit tests for src/eval.c -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Philipp Stephani <phst@google.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for src/eval.c. + +;;; Code: + +(require 'ert) + +(ert-deftest eval-tests--bug24673 () + "Checks that Bug#24673 has been fixed." + ;; This should not crash. + (should-error (funcall '(closure)) :type 'invalid-function)) + +(ert-deftest eval-tests--bugs-24912-and-24913 () + "Checks that Emacs doesn’t accept weird argument lists. +Bug#24912 and Bug#24913." + (dolist (args '((&optional) (&rest) (&optional &rest) (&rest &optional) + (&optional &rest a) (&optional a &rest) + (&rest a &optional) (&rest &optional a) + (&optional &optional) (&optional &optional a) + (&optional a &optional b) + (&rest &rest) (&rest &rest a) + (&rest a &rest b))) + (should-error (eval `(funcall (lambda ,args)) t) :type 'invalid-function) + (should-error (byte-compile-check-lambda-list args)) + (let ((byte-compile-debug t)) + (should-error (eval `(byte-compile (lambda ,args)) t))))) + +;;; eval-tests.el ends here diff --git a/test/automated/fns-tests.el b/test/src/fns-tests.el index 762f7bdd94f..c533bad3cdc 100644 --- a/test/automated/fns-tests.el +++ b/test/src/fns-tests.el @@ -191,3 +191,57 @@ (string-collate-lessp a b (if (eq system-type 'windows-nt) "enu_USA" "en_US.UTF-8"))))) '("Adrian" "Ævar" "Agustín" "Eli")))) + +(ert-deftest fns-tests-string-version-lessp () + (should (string-version-lessp "foo2.png" "foo12.png")) + (should (not (string-version-lessp "foo12.png" "foo2.png"))) + (should (string-version-lessp "foo12.png" "foo20000.png")) + (should (not (string-version-lessp "foo20000.png" "foo12.png"))) + (should (string-version-lessp "foo.png" "foo2.png")) + (should (not (string-version-lessp "foo2.png" "foo.png"))) + (should (equal (sort '("foo12.png" "foo2.png" "foo1.png") + 'string-version-lessp) + '("foo1.png" "foo2.png" "foo12.png"))) + (should (string-version-lessp "foo2" "foo1234")) + (should (not (string-version-lessp "foo1234" "foo2"))) + (should (string-version-lessp "foo.png" "foo2")) + (should (string-version-lessp "foo1.25.5.png" "foo1.125.5")) + (should (string-version-lessp "2" "1245")) + (should (not (string-version-lessp "1245" "2")))) + +(ert-deftest fns-tests-func-arity () + (should (equal (func-arity 'car) '(1 . 1))) + (should (equal (func-arity 'caar) '(1 . 1))) + (should (equal (func-arity 'format) '(1 . many))) + (require 'info) + (should (equal (func-arity 'Info-goto-node) '(1 . 3))) + (should (equal (func-arity (lambda (&rest x))) '(0 . many))) + (should (equal (func-arity (eval (lambda (x &optional y)) nil)) '(1 . 2))) + (should (equal (func-arity (eval (lambda (x &optional y)) t)) '(1 . 2))) + (should (equal (func-arity 'let) '(1 . unevalled)))) + +(ert-deftest fns-tests-hash-buffer () + (should (equal (sha1 "foo") "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33")) + (should (equal (with-temp-buffer + (insert "foo") + (buffer-hash)) + (sha1 "foo"))) + ;; This tests whether the presence of a gap in the middle of the + ;; buffer is handled correctly. + (should (equal (with-temp-buffer + (insert "foo") + (goto-char 2) + (insert " ") + (backward-delete-char 1) + (buffer-hash)) + (sha1 "foo")))) + +(ert-deftest fns-tests-mapcan () + (should-error (mapcan)) + (should-error (mapcan #'identity)) + (should-error (mapcan #'identity (make-char-table 'foo))) + (should (equal (mapcan #'list '(1 2 3)) '(1 2 3))) + ;; `mapcan' is destructive + (let ((data '((foo) (bar)))) + (should (equal (mapcan #'identity data) '(foo bar))) + (should (equal data '((foo bar) (bar)))))) diff --git a/test/automated/font-parse-tests.el b/test/src/font-tests.el index 9f730d3148c..f0f0d31efc7 100644 --- a/test/automated/font-parse-tests.el +++ b/test/src/font-tests.el @@ -1,4 +1,4 @@ -;;; font-parse-tests.el --- Test suite for font parsing. +;;; font-tests.el --- Test suite for font-related functions. ;; Copyright (C) 2011-2016 Free Software Foundation, Inc. @@ -163,4 +163,5 @@ expected font properties from parsing NAME.") ;; no-byte-compile: t ;; End: -;;; font-parse-tests.el ends here. +(provide 'font-tests) +;;; font-tests.el ends here. diff --git a/test/automated/inotify-test.el b/test/src/inotify-tests.el index 54977925f86..54977925f86 100644 --- a/test/automated/inotify-test.el +++ b/test/src/inotify-tests.el diff --git a/test/automated/keymap-tests.el b/test/src/keymap-tests.el index b835fc7530b..26d34858703 100644 --- a/test/automated/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -38,6 +38,13 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046." (should (eq (lookup-key Buffer-menu-mode-map [32]) 'undefined))) (define-key Buffer-menu-mode-map [32] def)))) +(ert-deftest keymap-where-is-internal-test () + "Make sure we don't crash when `where-is-preferred-modifier' is not a symbol." + (should + (equal (let ((where-is-preferred-modifier "alt")) + (where-is-internal 'execute-extended-command global-map t)) + [#x8000078]))) + (provide 'keymap-tests) ;;; keymap-tests.el ends here diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el new file mode 100644 index 00000000000..609f82ec20b --- /dev/null +++ b/test/src/lread-tests.el @@ -0,0 +1,115 @@ +;;; lread-tests.el --- tests for lread.c -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Philipp Stephani <phst@google.com> + +;; This file is part of GNU Emacs. + +;; This program 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, +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for code in src/lread.c. + +;;; Code: + +(ert-deftest lread-char-number () + (should (equal (read "?\\N{U+A817}") #xA817))) + +(ert-deftest lread-char-name-1 () + (should (equal (read "?\\N{SYLOTI NAGRI LETTER \n DHO}") + #xA817))) +(ert-deftest lread-char-name-2 () + (should (equal (read "?\\N{BED}") #x1F6CF))) +(ert-deftest lread-char-name-3 () + (should (equal (read "?\\N{U+BED}") #xBED))) +(ert-deftest lread-char-name-4 () + (should (equal (read "?\\N{VARIATION SELECTOR-1}") #xFE00))) +(ert-deftest lread-char-name-5 () + (should (equal (read "?\\N{VARIATION SELECTOR-16}") #xFE0F))) +(ert-deftest lread-char-name-6 () + (should (equal (read "?\\N{VARIATION SELECTOR-17}") #xE0100))) +(ert-deftest lread-char-name-7 () + (should (equal (read "?\\N{VARIATION SELECTOR-256}") #xE01EF))) +(ert-deftest lread-char-name-8 () + (should (equal (read "?\\N{CJK COMPATIBILITY IDEOGRAPH-F900}") #xF900))) +(ert-deftest lread-char-name-9 () + (should (equal (read "?\\N{CJK COMPATIBILITY IDEOGRAPH-FAD9}") #xFAD9))) +(ert-deftest lread-char-name-10 () + (should (equal (read "?\\N{CJK COMPATIBILITY IDEOGRAPH-2F800}") #x2F800))) +(ert-deftest lread-char-name-11 () + (should (equal (read "?\\N{CJK COMPATIBILITY IDEOGRAPH-2FA1D}") #x2FA1D))) + +(ert-deftest lread-char-invalid-number () + (should-error (read "?\\N{U+110000}") :type 'invalid-read-syntax)) + +(ert-deftest lread-char-invalid-name-1 () + (should-error (read "?\\N{DOES NOT EXIST}")) :type 'invalid-read-syntax) +(ert-deftest lread-char-invalid-name-2 () + (should-error (read "?\\N{VARIATION SELECTOR-0}")) :type 'invalid-read-syntax) +(ert-deftest lread-char-invalid-name-3 () + (should-error (read "?\\N{VARIATION SELECTOR-257}")) + :type 'invalid-read-syntax) +(ert-deftest lread-char-invalid-name-4 () + (should-error (read "?\\N{VARIATION SELECTOR--0}")) + :type 'invalid-read-syntax) +(ert-deftest lread-char-invalid-name-5 () + (should-error (read "?\\N{CJK COMPATIBILITY IDEOGRAPH-F8FF}")) + :type 'invalid-read-syntax) +(ert-deftest lread-char-invalid-name-6 () + (should-error (read "?\\N{CJK COMPATIBILITY IDEOGRAPH-FADA}")) + :type 'invalid-read-syntax) +(ert-deftest lread-char-invalid-name-7 () + (should-error (read "?\\N{CJK COMPATIBILITY IDEOGRAPH-2F7FF}")) + :type 'invalid-read-syntax) +(ert-deftest lread-char-invalid-name-8 () + (should-error (read "?\\N{CJK COMPATIBILITY IDEOGRAPH-2FA1E}")) + :type 'invalid-read-syntax) + +(ert-deftest lread-char-non-ascii-name () + (should-error (read "?\\N{LATIN CAPITAL LETTER Ø}") + :type 'invalid-read-syntax)) + +(ert-deftest lread-char-empty-name () + (should-error (read "?\\N{}") :type 'invalid-read-syntax)) + +(ert-deftest lread-char-surrogate-1 () + (should-error (read "?\\N{U+D800}") :type 'invalid-read-syntax)) +(ert-deftest lread-char-surrogate-2 () + (should-error (read "?\\N{U+D801}") :type 'invalid-read-syntax)) +(ert-deftest lread-char-surrogate-3 () + (should-error (read "?\\N{U+Dffe}") :type 'invalid-read-syntax)) +(ert-deftest lread-char-surrogate-4 () + (should-error (read "?\\N{U+DFFF}") :type 'invalid-read-syntax)) + +(ert-deftest lread-string-char-number-1 () + (should (equal (read "\"a\\N{U+A817}b\"") "a\uA817b"))) +(ert-deftest lread-string-char-number-2 () + (should-error (read "?\\N{0.5}") :type 'invalid-read-syntax)) +(ert-deftest lread-string-char-number-3 () + (should-error (read "?\\N{U+-0}") :type 'invalid-read-syntax)) + +(ert-deftest lread-string-char-name () + (should (equal (read "\"a\\N{SYLOTI NAGRI LETTER DHO}b\"") "a\uA817b"))) + +(ert-deftest lread-empty-int-literal () + "Check that Bug#25120 is fixed." + (should-error (read "#b") :type 'invalid-read-syntax) + (should-error (read "#o") :type 'invalid-read-syntax) + (should-error (read "#x") :type 'invalid-read-syntax) + (should-error (read "#24r") :type 'invalid-read-syntax) + (should-error (read "#") :type 'invalid-read-syntax)) + +;;; lread-tests.el ends here diff --git a/test/src/marker-tests.el b/test/src/marker-tests.el new file mode 100644 index 00000000000..18d49addb2f --- /dev/null +++ b/test/src/marker-tests.el @@ -0,0 +1,60 @@ +;;; marker-tests.el --- tests for marker.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) + +;; The following three tests assert that Emacs survives operations +;; copying a marker whose character position differs from its byte +;; position into a buffer whose character size equals its byte size +;; (Bug#24368). + +(ert-deftest marker-set-window-start-from-other-buffer () + "`set-window-start' from other buffer's marker." + (let ((text-quoting-style 'curve)) + (describe-function 'describe-function)) + (let* ((help (get-buffer "*Help*")) + (marker (with-current-buffer help + (copy-marker (point-max))))) + (should (set-window-start (selected-window) marker)))) + +(ert-deftest marker-set-window-point-from-other-buffer () + "`set-window-point' from another buffer's marker." + (let ((text-quoting-style 'curve)) + (describe-function 'describe-function)) + (let* ((help (get-buffer "*Help*")) + (marker (with-current-buffer help + (copy-marker (point-max))))) + (with-selected-window (get-buffer-window help) + (should (set-window-point (get-buffer-window "*scratch*") marker))))) + +(ert-deftest marker-goto-char-from-other-buffer () + "`goto-char' from another buffer's marker." + (let ((text-quoting-style 'curve)) + (describe-function 'describe-function)) + (let ((marker-1 (make-marker)) + (marker-2 (make-marker))) + (describe-function 'describe-function) + (with-current-buffer "*Help*" + (set-marker marker-1 (point-max))) + (set-marker marker-2 marker-1) + (should (goto-char marker-2)))) + +;;; marker-tests.el ends here. diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el new file mode 100644 index 00000000000..82ac0373cb4 --- /dev/null +++ b/test/src/minibuf-tests.el @@ -0,0 +1,403 @@ +;;; minibuf-tests.el --- tests for minibuf.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) + + +;;; Support functions for `try-completion', `all-completion', and +;;; `test-completion' tests. + +(defun minibuf-tests--strings-to-symbol-list (list) + (mapcar #'intern list)) +(defun minibuf-tests--strings-to-symbol-alist (list) + (let ((num 0)) + (mapcar (lambda (str) (cons (intern str) (cl-incf num))) list))) +(defun minibuf-tests--strings-to-string-alist (list) + (let ((num 0)) + (mapcar (lambda (str) (cons str (cl-incf num))) list))) +(defun minibuf-tests--strings-to-obarray (list) + (let ((ob (make-vector 7 0))) + (mapc (lambda (str) (intern str ob)) list) + ob)) +(defun minibuf-tests--strings-to-string-hashtable (list) + (let ((ht (make-hash-table :test #'equal)) + (num 0)) + (mapc (lambda (str) (puthash str (cl-incf num) ht)) list) + ht)) +(defun minibuf-tests--strings-to-symbol-hashtable (list) + (let ((ht (make-hash-table :test #'equal)) + (num 0)) + (mapc (lambda (str) (puthash (intern str) (cl-incf num) ht)) list) + ht)) + +;;; Functions that produce a predicate (for *-completion functions) +;;; which always returns non-nil for a given collection. + +(defun minibuf-tests--memq-of-collection (collection) + (lambda (elt) (memq elt collection))) +(defun minibuf-tests--part-of-obarray (ob) + (lambda (sym) (eq (intern-soft (symbol-name sym) ob) sym))) +(defun minibuf-tests--part-of-hashtable (table) + (lambda (k v) (equal (gethash k table) v))) + + +;;; Testing functions that are agnostic to type of COLLECTION. + +(defun minibuf-tests--try-completion (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (equal (try-completion "a" abcdef) "abc")) + (should (equal (try-completion "a" +abba) "ab")) + (should (equal (try-completion "abc" +abba) t)) + (should (equal (try-completion "abcd" +abba) nil)))) + +(defun minibuf-tests--try-completion-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (equal (try-completion "a" abcdef abcdef-member) "abc")) + (should (equal (try-completion "a" +abba +abba-member) "ab")) + (should (equal (try-completion "abc" +abba +abba-member) t)) + (should (equal (try-completion "abcd" +abba +abba-member) nil)) + (should-not (try-completion "a" abcdef #'ignore)) + (should-not (try-completion "a" +abba #'ignore)) + (should-not (try-completion "abc" +abba #'ignore)) + (should-not (try-completion "abcd" +abba #'ignore)))) + +(defun minibuf-tests--try-completion-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (equal (try-completion "a" abcdef) "abc")) + (should (equal (try-completion "a" +abba) "ab")) + (should (equal (try-completion "abc" +abba) t)) + (should (equal (try-completion "abcd" +abba) nil))) + (let ((completion-regexp-list '("X"))) + (should-not (try-completion "a" abcdef)) + (should-not (try-completion "a" +abba)) + (should-not (try-completion "abc" +abba)) + (should-not (try-completion "abcd" +abba))))) + +(defun minibuf-tests--all-completions (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (equal (all-completions "a" abcdef) '("abc"))) + (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba) '("abc"))) + (should (equal (all-completions "abcd" +abba) nil)))) + +(defun minibuf-tests--all-completions-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (equal (all-completions "a" abcdef abcdef-member) '("abc"))) + (should (equal (all-completions "a" +abba +abba-member) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba +abba-member) '("abc"))) + (should (equal (all-completions "abcd" +abba +abba-member) nil)) + (should-not (all-completions "a" abcdef #'ignore)) + (should-not (all-completions "a" +abba #'ignore)) + (should-not (all-completions "abc" +abba #'ignore)) + (should-not (all-completions "abcd" +abba #'ignore)))) + +(defun minibuf-tests--all-completions-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (equal (all-completions "a" abcdef) '("abc"))) + (should (equal (all-completions "a" +abba) '("abc" "abba"))) + (should (equal (all-completions "abc" +abba) '("abc"))) + (should (equal (all-completions "abcd" +abba) nil))) + (let ((completion-regexp-list '("X"))) + (should-not (all-completions "a" abcdef)) + (should-not (all-completions "a" +abba)) + (should-not (all-completions "abc" +abba)) + (should-not (all-completions "abcd" +abba))))) + +(defun minibuf-tests--test-completion (xform-collection) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (should (test-completion "abc" abcdef)) + (should (test-completion "def" +abba)) + (should (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba)))) + +(defun minibuf-tests--test-completion-pred (xform-collection collection-member) + (let* ((abcdef (funcall xform-collection '("abc" "def"))) + (abcdef-member (funcall collection-member abcdef)) + (+abba (funcall xform-collection '("abc" "abba" "def"))) + (+abba-member (funcall collection-member +abba))) + (should (test-completion "abc" abcdef abcdef-member)) + (should (test-completion "def" +abba +abba-member)) + (should (test-completion "abba" +abba +abba-member)) + (should-not (test-completion "abcd" +abba +abba-member)) + (should-not (test-completion "abc" abcdef #'ignore)) + (should-not (test-completion "def" +abba #'ignore)) + (should-not (test-completion "abba" +abba #'ignore)) + (should-not (test-completion "abcd" +abba #'ignore)))) + +(defun minibuf-tests--test-completion-regexp (xform-collection) + (let ((abcdef (funcall xform-collection '("abc" "def"))) + (+abba (funcall xform-collection '("abc" "abba" "def")))) + (let ((completion-regexp-list '("."))) + (should (test-completion "abc" abcdef)) + (should (test-completion "def" +abba)) + (should (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba))) + (let ((completion-regexp-list '("X"))) + (should-not (test-completion "abc" abcdef)) + (should-not (test-completion "def" +abba)) + (should-not (test-completion "abba" +abba)) + (should-not (test-completion "abcd" +abba))))) + + +;;; Tests for `try-completion'. +(ert-deftest try-completion-string-list () + (minibuf-tests--try-completion #'identity)) +(ert-deftest try-completion-string-list-predicate () + (minibuf-tests--try-completion-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-string-list-completion-regexp () + (minibuf-tests--try-completion-regexp #'identity)) + +(ert-deftest try-completion-symbol-list () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest try-completion-symbol-list-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-symbol-list-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest try-completion-symbol-alist () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest try-completion-symbol-alist-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-symbol-alist-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest try-completion-string-alist () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest try-completion-string-alist-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest try-completion-string-alist-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest try-completion-obarray () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-obarray)) +(ert-deftest try-completion-obarray-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest try-completion-obarray-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest try-completion-string-hashtable () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest try-completion-string-hashtable-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest try-completion-string-hashtable-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest try-completion-symbol-hashtable () + (minibuf-tests--try-completion + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest try-completion-symbol-hashtable-predicate () + (minibuf-tests--try-completion-pred + #'minibuf-tests--strings-to-symbol-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest try-completion-symbol-hashtable-completion-regexp () + (minibuf-tests--try-completion-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; Tests for `all-completions'. + +(ert-deftest all-completions-string-list () + (minibuf-tests--all-completions #'identity)) +(ert-deftest all-completions-string-list-predicate () + (minibuf-tests--all-completions-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-string-list-completion-regexp () + (minibuf-tests--all-completions-regexp #'identity)) + +(ert-deftest all-completions-symbol-list () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest all-completions-symbol-list-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-symbol-list-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest all-completions-symbol-alist () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest all-completions-symbol-alist-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-symbol-alist-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest all-completions-string-alist () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest all-completions-string-alist-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest all-completions-string-alist-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest all-completions-obarray () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-obarray)) +(ert-deftest all-completions-obarray-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest all-completions-obarray-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest all-completions-string-hashtable () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest all-completions-string-hashtable-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest all-completions-string-hashtable-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest all-completions-symbol-hashtable () + (minibuf-tests--all-completions + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest all-completions-symbol-hashtable-predicate () + (minibuf-tests--all-completions-pred + #'minibuf-tests--strings-to-symbol-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest all-completions-symbol-hashtable-completion-regexp () + (minibuf-tests--all-completions-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; Tests for `test-completion'. + +(ert-deftest test-completion-string-list () + (minibuf-tests--test-completion #'identity)) +(ert-deftest test-completion-string-list-predicate () + (minibuf-tests--test-completion-pred + #'identity #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-string-list-completion-regexp () + (minibuf-tests--test-completion-regexp #'identity)) + +(ert-deftest test-completion-symbol-list () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-list)) +(ert-deftest test-completion-symbol-list-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-list + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-symbol-list-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-list)) + +(ert-deftest test-completion-symbol-alist () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-alist)) +(ert-deftest test-completion-symbol-alist-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-symbol-alist-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-alist)) + +(ert-deftest test-completion-string-alist () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-string-alist)) +(ert-deftest test-completion-string-alist-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-string-alist + #'minibuf-tests--memq-of-collection)) +(ert-deftest test-completion-string-alist-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-string-alist)) + +(ert-deftest test-completion-obarray () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-obarray)) +(ert-deftest test-completion-obarray-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-obarray + #'minibuf-tests--part-of-obarray)) +(ert-deftest test-completion-obarray-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-obarray)) + +(ert-deftest test-completion-string-hashtable () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-string-hashtable)) +(ert-deftest test-completion-string-hashtable-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-string-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest test-completion-string-hashtable-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-string-hashtable)) + +(ert-deftest test-completion-symbol-hashtable () + (minibuf-tests--test-completion + #'minibuf-tests--strings-to-symbol-hashtable)) +(ert-deftest test-completion-symbol-hashtable-predicate () + (minibuf-tests--test-completion-pred + #'minibuf-tests--strings-to-symbol-hashtable + #'minibuf-tests--part-of-hashtable)) +(ert-deftest test-completion-symbol-hashtable-completion-regexp () + (minibuf-tests--test-completion-regexp + #'minibuf-tests--strings-to-symbol-hashtable)) + + +;;; minibuf-tests.el ends here diff --git a/test/automated/print-tests.el b/test/src/print-tests.el index 1abfa53581c..1abfa53581c 100644 --- a/test/automated/print-tests.el +++ b/test/src/print-tests.el diff --git a/test/automated/process-tests.el b/test/src/process-tests.el index 8554a287ccd..8cc59bf9feb 100644 --- a/test/automated/process-tests.el +++ b/test/src/process-tests.el @@ -163,3 +163,4 @@ (should (equal path samepath)))) (provide 'process-tests) +;; process-tests.el ends here. diff --git a/test/src/regex-resources/BOOST.tests b/test/src/regex-resources/BOOST.tests new file mode 100644 index 00000000000..98fd3b6abf3 --- /dev/null +++ b/test/src/regex-resources/BOOST.tests @@ -0,0 +1,829 @@ +; +; +; this file contains a script of tests to run through regress.exe +; +; comments start with a semicolon and proceed to the end of the line +; +; changes to regular expression compile flags start with a "-" as the first +; non-whitespace character and consist of a list of the printable names +; of the flags, for example "match_default" +; +; Other lines contain a test to perform using the current flag status +; the first token contains the expression to compile, the second the string +; to match it against. If the second string is "!" then the expression should +; not compile, that is the first string is an invalid regular expression. +; This is then followed by a list of integers that specify what should match, +; each pair represents the starting and ending positions of a subexpression +; starting with the zeroth subexpression (the whole match). +; A value of -1 indicates that the subexpression should not take part in the +; match at all, if the first value is -1 then no part of the expression should +; match the string. +; +; Tests taken from BOOST testsuite and adapted to glibc regex. +; +; Boost Software License - Version 1.0 - August 17th, 2003 +; +; Permission is hereby granted, free of charge, to any person or organization +; obtaining a copy of the software and accompanying documentation covered by +; this license (the "Software") to use, reproduce, display, distribute, +; execute, and transmit the Software, and to prepare derivative works of the +; Software, and to permit third-parties to whom the Software is furnished to +; do so, all subject to the following: +; +; The copyright notices in the Software and this entire statement, including +; the above license grant, this restriction and the following disclaimer, +; must be included in all copies of the Software, in whole or in part, and +; all derivative works of the Software, unless such copies or derivative +; works are solely in the form of machine-executable object code generated by +; a source language processor. +; +; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +; FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT +; SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE +; FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, +; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +; DEALINGS IN THE SOFTWARE. +; + +- match_default normal REG_EXTENDED + +; +; try some really simple literals: +a a 0 1 +Z Z 0 1 +Z aaa -1 -1 +Z xxxxZZxxx 4 5 + +; and some simple brackets: +(a) zzzaazz 3 4 3 4 +() zzz 0 0 0 0 +() "" 0 0 0 0 +( ! +) ) 0 1 +(aa ! +aa) baa)b 1 4 +a b -1 -1 +\(\) () 0 2 +\(a\) (a) 0 3 +\() () 0 2 +(\) ! +p(a)rameter ABCparameterXYZ 3 12 4 5 +[pq](a)rameter ABCparameterXYZ 3 12 4 5 + +; now try escaped brackets: +- match_default bk_parens REG_BASIC +\(a\) zzzaazz 3 4 3 4 +\(\) zzz 0 0 0 0 +\(\) "" 0 0 0 0 +\( ! +\) ! +\(aa ! +aa\) ! +() () 0 2 +(a) (a) 0 3 +(\) ! +\() ! + +; now move on to "." wildcards +- match_default normal REG_EXTENDED REG_STARTEND +. a 0 1 +. \n 0 1 +. \r 0 1 +. \0 0 1 + +; +; now move on to the repetion ops, +; starting with operator * +- match_default normal REG_EXTENDED +a* b 0 0 +ab* a 0 1 +ab* ab 0 2 +ab* sssabbbbbbsss 3 10 +ab*c* a 0 1 +ab*c* abbb 0 4 +ab*c* accc 0 4 +ab*c* abbcc 0 5 +*a ! +\<* ! +\>* ! +\n* \n\n 0 2 +\** ** 0 2 +\* * 0 1 + +; now try operator + +ab+ a -1 -1 +ab+ ab 0 2 +ab+ sssabbbbbbsss 3 10 +ab+c+ a -1 -1 +ab+c+ abbb -1 -1 +ab+c+ accc -1 -1 +ab+c+ abbcc 0 5 ++a ! +\<+ ! +\>+ ! +\n+ \n\n 0 2 +\+ + 0 1 +\+ ++ 0 1 +\++ ++ 0 2 + +; now try operator ? +- match_default normal REG_EXTENDED +a? b 0 0 +ab? a 0 1 +ab? ab 0 2 +ab? sssabbbbbbsss 3 5 +ab?c? a 0 1 +ab?c? abbb 0 2 +ab?c? accc 0 2 +ab?c? abcc 0 3 +?a ! +\<? ! +\>? ! +\n? \n\n 0 1 +\? ? 0 1 +\? ?? 0 1 +\?? ?? 0 1 + +; now try operator {} +- match_default normal REG_EXTENDED +a{2} a -1 -1 +a{2} aa 0 2 +a{2} aaa 0 2 +a{2,} a -1 -1 +a{2,} aa 0 2 +a{2,} aaaaa 0 5 +a{2,4} a -1 -1 +a{2,4} aa 0 2 +a{2,4} aaa 0 3 +a{2,4} aaaa 0 4 +a{2,4} aaaaa 0 4 +a{} ! +a{2 ! +a} a} 0 2 +\{\} {} 0 2 + +- match_default normal REG_BASIC +a\{2\} a -1 -1 +a\{2\} aa 0 2 +a\{2\} aaa 0 2 +a\{2,\} a -1 -1 +a\{2,\} aa 0 2 +a\{2,\} aaaaa 0 5 +a\{2,4\} a -1 -1 +a\{2,4\} aa 0 2 +a\{2,4\} aaa 0 3 +a\{2,4\} aaaa 0 4 +a\{2,4\} aaaaa 0 4 +{} {} 0 2 + +; now test the alternation operator | +- match_default normal REG_EXTENDED +a|b a 0 1 +a|b b 0 1 +a(b|c) ab 0 2 1 2 +a(b|c) ac 0 2 1 2 +a(b|c) ad -1 -1 -1 -1 +a\| a| 0 2 + +; now test the set operator [] +- match_default normal REG_EXTENDED +; try some literals first +[abc] a 0 1 +[abc] b 0 1 +[abc] c 0 1 +[abc] d -1 -1 +[^bcd] a 0 1 +[^bcd] b -1 -1 +[^bcd] d -1 -1 +[^bcd] e 0 1 +a[b]c abc 0 3 +a[ab]c abc 0 3 +a[^ab]c adc 0 3 +a[]b]c a]c 0 3 +a[[b]c a[c 0 3 +a[-b]c a-c 0 3 +a[^]b]c adc 0 3 +a[^-b]c adc 0 3 +a[b-]c a-c 0 3 +a[b ! +a[] ! + +; then some ranges +[b-e] a -1 -1 +[b-e] b 0 1 +[b-e] e 0 1 +[b-e] f -1 -1 +[^b-e] a 0 1 +[^b-e] b -1 -1 +[^b-e] e -1 -1 +[^b-e] f 0 1 +a[1-3]c a2c 0 3 +a[3-1]c ! +a[1-3-5]c ! +a[1- ! + +; and some classes +a[[:alpha:]]c abc 0 3 +a[[:unknown:]]c ! +a[[: ! +a[[:alpha ! +a[[:alpha:] ! +a[[:alpha,:] ! +a[[:]:]]b ! +a[[:-:]]b ! +a[[:alph:]] ! +a[[:alphabet:]] ! +[[:alnum:]]+ -%@a0X_- 3 6 +[[:alpha:]]+ -%@aX_0- 3 5 +[[:blank:]]+ "a \tb" 1 4 +[[:cntrl:]]+ a\n\tb 1 3 +[[:digit:]]+ a019b 1 4 +[[:graph:]]+ " a%b " 1 4 +[[:lower:]]+ AabC 1 3 +; This test fails with STLPort, disable for now as this is a corner case anyway... +;[[:print:]]+ "\na b\n" 1 4 +[[:punct:]]+ " %-&\t" 1 4 +[[:space:]]+ "a \n\t\rb" 1 5 +[[:upper:]]+ aBCd 1 3 +[[:xdigit:]]+ p0f3Cx 1 5 + +; now test flag settings: +- escape_in_lists REG_NO_POSIX_TEST +[\n] \n 0 1 +- REG_NO_POSIX_TEST + +; line anchors +- match_default normal REG_EXTENDED +^ab ab 0 2 +^ab xxabxx -1 -1 +ab$ ab 0 2 +ab$ abxx -1 -1 +- match_default match_not_bol match_not_eol normal REG_EXTENDED REG_NOTBOL REG_NOTEOL +^ab ab -1 -1 +^ab xxabxx -1 -1 +ab$ ab -1 -1 +ab$ abxx -1 -1 + +; back references +- match_default normal REG_PERL +a(b)\2c ! +a(b\1)c ! +a(b*)c\1d abbcbbd 0 7 1 3 +a(b*)c\1d abbcbd -1 -1 +a(b*)c\1d abbcbbbd -1 -1 +^(.)\1 abc -1 -1 +a([bc])\1d abcdabbd 4 8 5 6 +; strictly speaking this is at best ambiguous, at worst wrong, this is what most +; re implimentations will match though. +a(([bc])\2)*d abbccd 0 6 3 5 3 4 + +a(([bc])\2)*d abbcbd -1 -1 +a((b)*\2)*d abbbd 0 5 1 4 2 3 +; perl only: +(ab*)[ab]*\1 ababaaa 0 7 0 1 +(a)\1bcd aabcd 0 5 0 1 +(a)\1bc*d aabcd 0 5 0 1 +(a)\1bc*d aabd 0 4 0 1 +(a)\1bc*d aabcccd 0 7 0 1 +(a)\1bc*[ce]d aabcccd 0 7 0 1 +^(a)\1b(c)*cd$ aabcccd 0 7 0 1 4 5 + +; posix only: +- match_default extended REG_EXTENDED +(ab*)[ab]*\1 ababaaa 0 7 0 1 + +; +; word operators: +\w a 0 1 +\w z 0 1 +\w A 0 1 +\w Z 0 1 +\w _ 0 1 +\w } -1 -1 +\w ` -1 -1 +\w [ -1 -1 +\w @ -1 -1 +; non-word: +\W a -1 -1 +\W z -1 -1 +\W A -1 -1 +\W Z -1 -1 +\W _ -1 -1 +\W } 0 1 +\W ` 0 1 +\W [ 0 1 +\W @ 0 1 +; word start: +\<abcd " abcd" 2 6 +\<ab cab -1 -1 +\<ab "\nab" 1 3 +\<tag ::tag 2 5 +;word end: +abc\> abc 0 3 +abc\> abcd -1 -1 +abc\> abc\n 0 3 +abc\> abc:: 0 3 +; word boundary: +\babcd " abcd" 2 6 +\bab cab -1 -1 +\bab "\nab" 1 3 +\btag ::tag 2 5 +abc\b abc 0 3 +abc\b abcd -1 -1 +abc\b abc\n 0 3 +abc\b abc:: 0 3 +; within word: +\B ab 1 1 +a\Bb ab 0 2 +a\B ab 0 1 +a\B a -1 -1 +a\B "a " -1 -1 + +; +; buffer operators: +\`abc abc 0 3 +\`abc \nabc -1 -1 +\`abc " abc" -1 -1 +abc\' abc 0 3 +abc\' abc\n -1 -1 +abc\' "abc " -1 -1 + +; +; now follows various complex expressions designed to try and bust the matcher: +a(((b)))c abc 0 3 1 2 1 2 1 2 +a(b|(c))d abd 0 3 1 2 -1 -1 +a(b|(c))d acd 0 3 1 2 1 2 +a(b*|c)d abbd 0 4 1 3 +; just gotta have one DFA-buster, of course +a[ab]{20} aaaaabaaaabaaaabaaaab 0 21 +; and an inline expansion in case somebody gets tricky +a[ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab] aaaaabaaaabaaaabaaaab 0 21 +; and in case somebody just slips in an NFA... +a[ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab][ab](wee|week)(knights|night) aaaaabaaaabaaaabaaaabweeknights 0 31 21 24 24 31 +; one really big one +1234567890123456789012345678901234567890123456789012345678901234567890 a1234567890123456789012345678901234567890123456789012345678901234567890b 1 71 +; fish for problems as brackets go past 8 +[ab][cd][ef][gh][ij][kl][mn] xacegikmoq 1 8 +[ab][cd][ef][gh][ij][kl][mn][op] xacegikmoq 1 9 +[ab][cd][ef][gh][ij][kl][mn][op][qr] xacegikmoqy 1 10 +[ab][cd][ef][gh][ij][kl][mn][op][q] xacegikmoqy 1 10 +; and as parenthesis go past 9: +(a)(b)(c)(d)(e)(f)(g)(h) zabcdefghi 1 9 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 +(a)(b)(c)(d)(e)(f)(g)(h)(i) zabcdefghij 1 10 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 +(a)(b)(c)(d)(e)(f)(g)(h)(i)(j) zabcdefghijk 1 11 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 +(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(k) zabcdefghijkl 1 12 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 10 10 11 11 12 +(a)d|(b)c abc 1 3 -1 -1 1 2 +_+((www)|(ftp)|(mailto)):_* "_wwwnocolon _mailto:" 12 20 13 19 -1 -1 -1 -1 13 19 + +; subtleties of matching +;a(b)?c\1d acd 0 3 -1 -1 +; POSIX is about the following test: +a(b)?c\1d acd -1 -1 -1 -1 +a(b?c)+d accd 0 4 2 3 +(wee|week)(knights|night) weeknights 0 10 0 3 3 10 +.* abc 0 3 +a(b|(c))d abd 0 3 1 2 -1 -1 +a(b|(c))d acd 0 3 1 2 1 2 +a(b*|c|e)d abbd 0 4 1 3 +a(b*|c|e)d acd 0 3 1 2 +a(b*|c|e)d ad 0 2 1 1 +a(b?)c abc 0 3 1 2 +a(b?)c ac 0 2 1 1 +a(b+)c abc 0 3 1 2 +a(b+)c abbbc 0 5 1 4 +a(b*)c ac 0 2 1 1 +(a|ab)(bc([de]+)f|cde) abcdef 0 6 0 1 1 6 3 5 +a([bc]?)c abc 0 3 1 2 +a([bc]?)c ac 0 2 1 1 +a([bc]+)c abc 0 3 1 2 +a([bc]+)c abcc 0 4 1 3 +a([bc]+)bc abcbc 0 5 1 3 +a(bb+|b)b abb 0 3 1 2 +a(bbb+|bb+|b)b abb 0 3 1 2 +a(bbb+|bb+|b)b abbb 0 4 1 3 +a(bbb+|bb+|b)bb abbb 0 4 1 2 +(.*).* abcdef 0 6 0 6 +(a*)* bc 0 0 0 0 +xyx*xz xyxxxxyxxxz 5 11 + +; do we get the right subexpression when it is used more than once? +a(b|c)*d ad 0 2 -1 -1 +a(b|c)*d abcd 0 4 2 3 +a(b|c)+d abd 0 3 1 2 +a(b|c)+d abcd 0 4 2 3 +a(b|c?)+d ad 0 2 1 1 +a(b|c){0,0}d ad 0 2 -1 -1 +a(b|c){0,1}d ad 0 2 -1 -1 +a(b|c){0,1}d abd 0 3 1 2 +a(b|c){0,2}d ad 0 2 -1 -1 +a(b|c){0,2}d abcd 0 4 2 3 +a(b|c){0,}d ad 0 2 -1 -1 +a(b|c){0,}d abcd 0 4 2 3 +a(b|c){1,1}d abd 0 3 1 2 +a(b|c){1,2}d abd 0 3 1 2 +a(b|c){1,2}d abcd 0 4 2 3 +a(b|c){1,}d abd 0 3 1 2 +a(b|c){1,}d abcd 0 4 2 3 +a(b|c){2,2}d acbd 0 4 2 3 +a(b|c){2,2}d abcd 0 4 2 3 +a(b|c){2,4}d abcd 0 4 2 3 +a(b|c){2,4}d abcbd 0 5 3 4 +a(b|c){2,4}d abcbcd 0 6 4 5 +a(b|c){2,}d abcd 0 4 2 3 +a(b|c){2,}d abcbd 0 5 3 4 +; perl only: these conflict with the POSIX test below +;a(b|c?)+d abcd 0 4 3 3 +;a(b+|((c)*))+d abd 0 3 2 2 2 2 -1 -1 +;a(b+|((c)*))+d abcd 0 4 3 3 3 3 2 3 + +; posix only: +- match_default extended REG_EXTENDED REG_STARTEND + +a(b|c?)+d abcd 0 4 2 3 +a(b|((c)*))+d abcd 0 4 2 3 2 3 2 3 +a(b+|((c)*))+d abd 0 3 1 2 -1 -1 -1 -1 +a(b+|((c)*))+d abcd 0 4 2 3 2 3 2 3 +a(b|((c)*))+d ad 0 2 1 1 1 1 -1 -1 +a(b|((c)*))*d abcd 0 4 2 3 2 3 2 3 +a(b+|((c)*))*d abd 0 3 1 2 -1 -1 -1 -1 +a(b+|((c)*))*d abcd 0 4 2 3 2 3 2 3 +a(b|((c)*))*d ad 0 2 1 1 1 1 -1 -1 + +- match_default normal REG_PERL +; try to match C++ syntax elements: +; line comment: +//[^\n]* "++i //here is a line comment\n" 4 28 +; block comment: +/\*([^*]|\*+[^*/])*\*+/ "/* here is a block comment */" 0 29 26 27 +/\*([^*]|\*+[^*/])*\*+/ "/**/" 0 4 -1 -1 +/\*([^*]|\*+[^*/])*\*+/ "/***/" 0 5 -1 -1 +/\*([^*]|\*+[^*/])*\*+/ "/****/" 0 6 -1 -1 +/\*([^*]|\*+[^*/])*\*+/ "/*****/" 0 7 -1 -1 +/\*([^*]|\*+[^*/])*\*+/ "/*****/*/" 0 7 -1 -1 +; preprossor directives: +^[[:blank:]]*#([^\n]*\\[[:space:]]+)*[^\n]* "#define some_symbol" 0 19 -1 -1 +^[[:blank:]]*#([^\n]*\\[[:space:]]+)*[^\n]* "#define some_symbol(x) #x" 0 25 -1 -1 +; perl only: +^[[:blank:]]*#([^\n]*\\[[:space:]]+)*[^\n]* "#define some_symbol(x) \\ \r\n foo();\\\r\n printf(#x);" 0 53 30 42 +; literals: +((0x[[:xdigit:]]+)|([[:digit:]]+))u?((int(8|16|32|64))|L)? 0xFF 0 4 0 4 0 4 -1 -1 -1 -1 -1 -1 -1 -1 +((0x[[:xdigit:]]+)|([[:digit:]]+))u?((int(8|16|32|64))|L)? 35 0 2 0 2 -1 -1 0 2 -1 -1 -1 -1 -1 -1 +((0x[[:xdigit:]]+)|([[:digit:]]+))u?((int(8|16|32|64))|L)? 0xFFu 0 5 0 4 0 4 -1 -1 -1 -1 -1 -1 -1 -1 +((0x[[:xdigit:]]+)|([[:digit:]]+))u?((int(8|16|32|64))|L)? 0xFFL 0 5 0 4 0 4 -1 -1 4 5 -1 -1 -1 -1 +((0x[[:xdigit:]]+)|([[:digit:]]+))u?((int(8|16|32|64))|L)? 0xFFFFFFFFFFFFFFFFuint64 0 24 0 18 0 18 -1 -1 19 24 19 24 22 24 +; strings: +'([^\\']|\\.)*' '\\x3A' 0 6 4 5 +'([^\\']|\\.)*' '\\'' 0 4 1 3 +'([^\\']|\\.)*' '\\n' 0 4 1 3 + +; finally try some case insensitive matches: +- match_default normal REG_EXTENDED REG_ICASE +; upper and lower have no meaning here so they fail, however these +; may compile with other libraries... +;[[:lower:]] ! +;[[:upper:]] ! +0123456789@abcdefghijklmnopqrstuvwxyz\[\\\]\^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ\{\|\} 0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]\^_`abcdefghijklmnopqrstuvwxyz\{\|\} 0 72 + +; known and suspected bugs: +- match_default normal REG_EXTENDED +\( ( 0 1 +\) ) 0 1 +\$ $ 0 1 +\^ ^ 0 1 +\. . 0 1 +\* * 0 1 +\+ + 0 1 +\? ? 0 1 +\[ [ 0 1 +\] ] 0 1 +\| | 0 1 +\\ \\ 0 1 +# # 0 1 +\# # 0 1 +a- a- 0 2 +\- - 0 1 +\{ { 0 1 +\} } 0 1 +0 0 0 1 +1 1 0 1 +9 9 0 1 +b b 0 1 +B B 0 1 +< < 0 1 +> > 0 1 +w w 0 1 +W W 0 1 +` ` 0 1 +' ' 0 1 +\n \n 0 1 +, , 0 1 +a a 0 1 +f f 0 1 +n n 0 1 +r r 0 1 +t t 0 1 +v v 0 1 +c c 0 1 +x x 0 1 +: : 0 1 +(\.[[:alnum:]]+){2} "w.a.b " 1 5 3 5 + +- match_default normal REG_EXTENDED REG_ICASE +a A 0 1 +A a 0 1 +[abc]+ abcABC 0 6 +[ABC]+ abcABC 0 6 +[a-z]+ abcABC 0 6 +[A-Z]+ abzANZ 0 6 +[a-Z]+ abzABZ 0 6 +[A-z]+ abzABZ 0 6 +[[:lower:]]+ abyzABYZ 0 8 +[[:upper:]]+ abzABZ 0 6 +[[:alpha:]]+ abyzABYZ 0 8 +[[:alnum:]]+ 09abyzABYZ 0 10 + +; word start: +\<abcd " abcd" 2 6 +\<ab cab -1 -1 +\<ab "\nab" 1 3 +\<tag ::tag 2 5 +;word end: +abc\> abc 0 3 +abc\> abcd -1 -1 +abc\> abc\n 0 3 +abc\> abc:: 0 3 + +; collating elements and rewritten set code: +- match_default normal REG_EXTENDED REG_STARTEND +;[[.zero.]] 0 0 1 +;[[.one.]] 1 0 1 +;[[.two.]] 2 0 1 +;[[.three.]] 3 0 1 +[[.a.]] baa 1 2 +;[[.right-curly-bracket.]] } 0 1 +;[[.NUL.]] \0 0 1 +[[:<:]z] ! +[a[:>:]] ! +[[=a=]] a 0 1 +;[[=right-curly-bracket=]] } 0 1 +- match_default normal REG_EXTENDED REG_STARTEND REG_ICASE +[[.A.]] A 0 1 +[[.A.]] a 0 1 +[[.A.]-b]+ AaBb 0 4 +[A-[.b.]]+ AaBb 0 4 +[[.a.]-B]+ AaBb 0 4 +[a-[.B.]]+ AaBb 0 4 +- match_default normal REG_EXTENDED REG_STARTEND +[[.a.]-c]+ abcd 0 3 +[a-[.c.]]+ abcd 0 3 +[[:alpha:]-a] ! +[a-[:alpha:]] ! + +; try mutli-character ligatures: +;[[.ae.]] ae 0 2 +;[[.ae.]] aE -1 -1 +;[[.AE.]] AE 0 2 +;[[.Ae.]] Ae 0 2 +;[[.ae.]-b] a -1 -1 +;[[.ae.]-b] b 0 1 +;[[.ae.]-b] ae 0 2 +;[a-[.ae.]] a 0 1 +;[a-[.ae.]] b -1 -1 +;[a-[.ae.]] ae 0 2 +- match_default normal REG_EXTENDED REG_STARTEND REG_ICASE +;[[.ae.]] AE 0 2 +;[[.ae.]] Ae 0 2 +;[[.AE.]] Ae 0 2 +;[[.Ae.]] aE 0 2 +;[[.AE.]-B] a -1 -1 +;[[.Ae.]-b] b 0 1 +;[[.Ae.]-b] B 0 1 +;[[.ae.]-b] AE 0 2 + +- match_default normal REG_EXTENDED REG_STARTEND REG_NO_POSIX_TEST +\s+ "ab ab" 2 5 +\S+ " abc " 2 5 + +- match_default normal REG_EXTENDED REG_STARTEND +\`abc abc 0 3 +\`abc aabc -1 -1 +abc\' abc 0 3 +abc\' abcd -1 -1 +abc\' abc\n\n -1 -1 +abc\' abc 0 3 + +; extended repeat checking to exercise new algorithms: +ab.*xy abxy_ 0 4 +ab.*xy ab_xy_ 0 5 +ab.*xy abxy 0 4 +ab.*xy ab_xy 0 5 +ab.* ab 0 2 +ab.* ab__ 0 4 + +ab.{2,5}xy ab__xy_ 0 6 +ab.{2,5}xy ab____xy_ 0 8 +ab.{2,5}xy ab_____xy_ 0 9 +ab.{2,5}xy ab__xy 0 6 +ab.{2,5}xy ab_____xy 0 9 +ab.{2,5} ab__ 0 4 +ab.{2,5} ab_______ 0 7 +ab.{2,5}xy ab______xy -1 -1 +ab.{2,5}xy ab_xy -1 -1 + +ab.*?xy abxy_ 0 4 +ab.*?xy ab_xy_ 0 5 +ab.*?xy abxy 0 4 +ab.*?xy ab_xy 0 5 +ab.*? ab 0 2 +ab.*? ab__ 0 4 + +ab.{2,5}?xy ab__xy_ 0 6 +ab.{2,5}?xy ab____xy_ 0 8 +ab.{2,5}?xy ab_____xy_ 0 9 +ab.{2,5}?xy ab__xy 0 6 +ab.{2,5}?xy ab_____xy 0 9 +ab.{2,5}? ab__ 0 4 +ab.{2,5}? ab_______ 0 7 +ab.{2,5}?xy ab______xy -1 -1 +ab.{2,5}xy ab_xy -1 -1 + +; again but with slower algorithm variant: +- match_default REG_EXTENDED +; now again for single character repeats: + +ab_*xy abxy_ 0 4 +ab_*xy ab_xy_ 0 5 +ab_*xy abxy 0 4 +ab_*xy ab_xy 0 5 +ab_* ab 0 2 +ab_* ab__ 0 4 + +ab_{2,5}xy ab__xy_ 0 6 +ab_{2,5}xy ab____xy_ 0 8 +ab_{2,5}xy ab_____xy_ 0 9 +ab_{2,5}xy ab__xy 0 6 +ab_{2,5}xy ab_____xy 0 9 +ab_{2,5} ab__ 0 4 +ab_{2,5} ab_______ 0 7 +ab_{2,5}xy ab______xy -1 -1 +ab_{2,5}xy ab_xy -1 -1 + +ab_*?xy abxy_ 0 4 +ab_*?xy ab_xy_ 0 5 +ab_*?xy abxy 0 4 +ab_*?xy ab_xy 0 5 +ab_*? ab 0 2 +ab_*? ab__ 0 4 + +ab_{2,5}?xy ab__xy_ 0 6 +ab_{2,5}?xy ab____xy_ 0 8 +ab_{2,5}?xy ab_____xy_ 0 9 +ab_{2,5}?xy ab__xy 0 6 +ab_{2,5}?xy ab_____xy 0 9 +ab_{2,5}? ab__ 0 4 +ab_{2,5}? ab_______ 0 7 +ab_{2,5}?xy ab______xy -1 -1 +ab_{2,5}xy ab_xy -1 -1 + +; and again for sets: +ab[_,;]*xy abxy_ 0 4 +ab[_,;]*xy ab_xy_ 0 5 +ab[_,;]*xy abxy 0 4 +ab[_,;]*xy ab_xy 0 5 +ab[_,;]* ab 0 2 +ab[_,;]* ab__ 0 4 + +ab[_,;]{2,5}xy ab__xy_ 0 6 +ab[_,;]{2,5}xy ab____xy_ 0 8 +ab[_,;]{2,5}xy ab_____xy_ 0 9 +ab[_,;]{2,5}xy ab__xy 0 6 +ab[_,;]{2,5}xy ab_____xy 0 9 +ab[_,;]{2,5} ab__ 0 4 +ab[_,;]{2,5} ab_______ 0 7 +ab[_,;]{2,5}xy ab______xy -1 -1 +ab[_,;]{2,5}xy ab_xy -1 -1 + +ab[_,;]*?xy abxy_ 0 4 +ab[_,;]*?xy ab_xy_ 0 5 +ab[_,;]*?xy abxy 0 4 +ab[_,;]*?xy ab_xy 0 5 +ab[_,;]*? ab 0 2 +ab[_,;]*? ab__ 0 4 + +ab[_,;]{2,5}?xy ab__xy_ 0 6 +ab[_,;]{2,5}?xy ab____xy_ 0 8 +ab[_,;]{2,5}?xy ab_____xy_ 0 9 +ab[_,;]{2,5}?xy ab__xy 0 6 +ab[_,;]{2,5}?xy ab_____xy 0 9 +ab[_,;]{2,5}? ab__ 0 4 +ab[_,;]{2,5}? ab_______ 0 7 +ab[_,;]{2,5}?xy ab______xy -1 -1 +ab[_,;]{2,5}xy ab_xy -1 -1 + +; and again for tricky sets with digraphs: +;ab[_[.ae.]]*xy abxy_ 0 4 +;ab[_[.ae.]]*xy ab_xy_ 0 5 +;ab[_[.ae.]]*xy abxy 0 4 +;ab[_[.ae.]]*xy ab_xy 0 5 +;ab[_[.ae.]]* ab 0 2 +;ab[_[.ae.]]* ab__ 0 4 + +;ab[_[.ae.]]{2,5}xy ab__xy_ 0 6 +;ab[_[.ae.]]{2,5}xy ab____xy_ 0 8 +;ab[_[.ae.]]{2,5}xy ab_____xy_ 0 9 +;ab[_[.ae.]]{2,5}xy ab__xy 0 6 +;ab[_[.ae.]]{2,5}xy ab_____xy 0 9 +;ab[_[.ae.]]{2,5} ab__ 0 4 +;ab[_[.ae.]]{2,5} ab_______ 0 7 +;ab[_[.ae.]]{2,5}xy ab______xy -1 -1 +;ab[_[.ae.]]{2,5}xy ab_xy -1 -1 + +;ab[_[.ae.]]*?xy abxy_ 0 4 +;ab[_[.ae.]]*?xy ab_xy_ 0 5 +;ab[_[.ae.]]*?xy abxy 0 4 +;ab[_[.ae.]]*?xy ab_xy 0 5 +;ab[_[.ae.]]*? ab 0 2 +;ab[_[.ae.]]*? ab__ 0 2 + +;ab[_[.ae.]]{2,5}?xy ab__xy_ 0 6 +;ab[_[.ae.]]{2,5}?xy ab____xy_ 0 8 +;ab[_[.ae.]]{2,5}?xy ab_____xy_ 0 9 +;ab[_[.ae.]]{2,5}?xy ab__xy 0 6 +;ab[_[.ae.]]{2,5}?xy ab_____xy 0 9 +;ab[_[.ae.]]{2,5}? ab__ 0 4 +;ab[_[.ae.]]{2,5}? ab_______ 0 4 +;ab[_[.ae.]]{2,5}?xy ab______xy -1 -1 +;ab[_[.ae.]]{2,5}xy ab_xy -1 -1 + +; new bugs detected in spring 2003: +- normal match_continuous REG_NO_POSIX_TEST +b abc 1 2 + +() abc 0 0 0 0 +^() abc 0 0 0 0 +^()+ abc 0 0 0 0 +^(){1} abc 0 0 0 0 +^(){2} abc 0 0 0 0 +^((){2}) abc 0 0 0 0 0 0 +() "" 0 0 0 0 +()\1 "" 0 0 0 0 +()\1 a 0 0 0 0 +a()\1b ab 0 2 1 1 +a()b\1 ab 0 2 1 1 + +; subtleties of matching with no sub-expressions marked +- normal match_nosubs REG_NO_POSIX_TEST +a(b?c)+d accd 0 4 +(wee|week)(knights|night) weeknights 0 10 +.* abc 0 3 +a(b|(c))d abd 0 3 +a(b|(c))d acd 0 3 +a(b*|c|e)d abbd 0 4 +a(b*|c|e)d acd 0 3 +a(b*|c|e)d ad 0 2 +a(b?)c abc 0 3 +a(b?)c ac 0 2 +a(b+)c abc 0 3 +a(b+)c abbbc 0 5 +a(b*)c ac 0 2 +(a|ab)(bc([de]+)f|cde) abcdef 0 6 +a([bc]?)c abc 0 3 +a([bc]?)c ac 0 2 +a([bc]+)c abc 0 3 +a([bc]+)c abcc 0 4 +a([bc]+)bc abcbc 0 5 +a(bb+|b)b abb 0 3 +a(bbb+|bb+|b)b abb 0 3 +a(bbb+|bb+|b)b abbb 0 4 +a(bbb+|bb+|b)bb abbb 0 4 +(.*).* abcdef 0 6 +(a*)* bc 0 0 + +- normal nosubs REG_NO_POSIX_TEST +a(b?c)+d accd 0 4 +(wee|week)(knights|night) weeknights 0 10 +.* abc 0 3 +a(b|(c))d abd 0 3 +a(b|(c))d acd 0 3 +a(b*|c|e)d abbd 0 4 +a(b*|c|e)d acd 0 3 +a(b*|c|e)d ad 0 2 +a(b?)c abc 0 3 +a(b?)c ac 0 2 +a(b+)c abc 0 3 +a(b+)c abbbc 0 5 +a(b*)c ac 0 2 +(a|ab)(bc([de]+)f|cde) abcdef 0 6 +a([bc]?)c abc 0 3 +a([bc]?)c ac 0 2 +a([bc]+)c abc 0 3 +a([bc]+)c abcc 0 4 +a([bc]+)bc abcbc 0 5 +a(bb+|b)b abb 0 3 +a(bbb+|bb+|b)b abb 0 3 +a(bbb+|bb+|b)b abbb 0 4 +a(bbb+|bb+|b)bb abbb 0 4 +(.*).* abcdef 0 6 +(a*)* bc 0 0 + diff --git a/test/src/regex-resources/PCRE.tests b/test/src/regex-resources/PCRE.tests new file mode 100644 index 00000000000..0fb9cadafc9 --- /dev/null +++ b/test/src/regex-resources/PCRE.tests @@ -0,0 +1,2386 @@ +# PCRE version 4.4 21-August-2003 + +# Tests taken from PCRE and modified to suit glibc regex. +# +# PCRE LICENCE +# ------------ +# +# PCRE is a library of functions to support regular expressions whose syntax +# and semantics are as close as possible to those of the Perl 5 language. +# +# Written by: Philip Hazel <ph10@cam.ac.uk> +# +# University of Cambridge Computing Service, +# Cambridge, England. Phone: +44 1223 334714. +# +# Copyright (c) 1997-2003 University of Cambridge +# +# Permission is granted to anyone to use this software for any purpose on any +# computer system, and to redistribute it freely, subject to the following +# restrictions: +# +# 1. This software 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. +# +# 2. The origin of this software must not be misrepresented, either by +# explicit claim or by omission. In practice, this means that if you use +# PCRE in software that you distribute to others, commercially or +# otherwise, you must put a sentence like this +# +# Regular expression support is provided by the PCRE library package, +# which is open source software, written by Philip Hazel, and copyright +# by the University of Cambridge, England. +# +# somewhere reasonably visible in your documentation and in any relevant +# files or online help data or similar. A reference to the ftp site for +# the source, that is, to +# +# ftp://ftp.csx.cam.ac.uk/pub/software/programming/pcre/ +# +# should also be given in the documentation. However, this condition is not +# intended to apply to whole chains of software. If package A includes PCRE, +# it must acknowledge it, but if package B is software that includes package +# A, the condition is not imposed on package B (unless it uses PCRE +# independently). +# +# 3. Altered versions must be plainly marked as such, and must not be +# misrepresented as being the original software. +# +# 4. If PCRE is embedded in any software that is released under the GNU +# General Purpose Licence (GPL), or Lesser General Purpose Licence (LGPL), +# then the terms of that licence shall supersede any condition above with +# which it is incompatible. +# +# The documentation for PCRE, supplied in the "doc" directory, is distributed +# under the same terms as the software itself. +# +# End +# + +/the quick brown fox/ + the quick brown fox + 0: the quick brown fox + The quick brown FOX +No match + What do you know about the quick brown fox? + 0: the quick brown fox + What do you know about THE QUICK BROWN FOX? +No match + +/The quick brown fox/i + the quick brown fox + 0: the quick brown fox + The quick brown FOX + 0: The quick brown FOX + What do you know about the quick brown fox? + 0: the quick brown fox + What do you know about THE QUICK BROWN FOX? + 0: THE QUICK BROWN FOX + +/a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz/ + abxyzpqrrrabbxyyyypqAzz + 0: abxyzpqrrrabbxyyyypqAzz + abxyzpqrrrabbxyyyypqAzz + 0: abxyzpqrrrabbxyyyypqAzz + aabxyzpqrrrabbxyyyypqAzz + 0: aabxyzpqrrrabbxyyyypqAzz + aaabxyzpqrrrabbxyyyypqAzz + 0: aaabxyzpqrrrabbxyyyypqAzz + aaaabxyzpqrrrabbxyyyypqAzz + 0: aaaabxyzpqrrrabbxyyyypqAzz + abcxyzpqrrrabbxyyyypqAzz + 0: abcxyzpqrrrabbxyyyypqAzz + aabcxyzpqrrrabbxyyyypqAzz + 0: aabcxyzpqrrrabbxyyyypqAzz + aaabcxyzpqrrrabbxyyyypAzz + 0: aaabcxyzpqrrrabbxyyyypAzz + aaabcxyzpqrrrabbxyyyypqAzz + 0: aaabcxyzpqrrrabbxyyyypqAzz + aaabcxyzpqrrrabbxyyyypqqAzz + 0: aaabcxyzpqrrrabbxyyyypqqAzz + aaabcxyzpqrrrabbxyyyypqqqAzz + 0: aaabcxyzpqrrrabbxyyyypqqqAzz + aaabcxyzpqrrrabbxyyyypqqqqAzz + 0: aaabcxyzpqrrrabbxyyyypqqqqAzz + aaabcxyzpqrrrabbxyyyypqqqqqAzz + 0: aaabcxyzpqrrrabbxyyyypqqqqqAzz + aaabcxyzpqrrrabbxyyyypqqqqqqAzz + 0: aaabcxyzpqrrrabbxyyyypqqqqqqAzz + aaaabcxyzpqrrrabbxyyyypqAzz + 0: aaaabcxyzpqrrrabbxyyyypqAzz + abxyzzpqrrrabbxyyyypqAzz + 0: abxyzzpqrrrabbxyyyypqAzz + aabxyzzzpqrrrabbxyyyypqAzz + 0: aabxyzzzpqrrrabbxyyyypqAzz + aaabxyzzzzpqrrrabbxyyyypqAzz + 0: aaabxyzzzzpqrrrabbxyyyypqAzz + aaaabxyzzzzpqrrrabbxyyyypqAzz + 0: aaaabxyzzzzpqrrrabbxyyyypqAzz + abcxyzzpqrrrabbxyyyypqAzz + 0: abcxyzzpqrrrabbxyyyypqAzz + aabcxyzzzpqrrrabbxyyyypqAzz + 0: aabcxyzzzpqrrrabbxyyyypqAzz + aaabcxyzzzzpqrrrabbxyyyypqAzz + 0: aaabcxyzzzzpqrrrabbxyyyypqAzz + aaaabcxyzzzzpqrrrabbxyyyypqAzz + 0: aaaabcxyzzzzpqrrrabbxyyyypqAzz + aaaabcxyzzzzpqrrrabbbxyyyypqAzz + 0: aaaabcxyzzzzpqrrrabbbxyyyypqAzz + aaaabcxyzzzzpqrrrabbbxyyyyypqAzz + 0: aaaabcxyzzzzpqrrrabbbxyyyyypqAzz + aaabcxyzpqrrrabbxyyyypABzz + 0: aaabcxyzpqrrrabbxyyyypABzz + aaabcxyzpqrrrabbxyyyypABBzz + 0: aaabcxyzpqrrrabbxyyyypABBzz + >>>aaabxyzpqrrrabbxyyyypqAzz + 0: aaabxyzpqrrrabbxyyyypqAzz + >aaaabxyzpqrrrabbxyyyypqAzz + 0: aaaabxyzpqrrrabbxyyyypqAzz + >>>>abcxyzpqrrrabbxyyyypqAzz + 0: abcxyzpqrrrabbxyyyypqAzz + *** Failers +No match + abxyzpqrrabbxyyyypqAzz +No match + abxyzpqrrrrabbxyyyypqAzz +No match + abxyzpqrrrabxyyyypqAzz +No match + aaaabcxyzzzzpqrrrabbbxyyyyyypqAzz +No match + aaaabcxyzzzzpqrrrabbbxyyypqAzz +No match + aaabcxyzpqrrrabbxyyyypqqqqqqqAzz +No match + +/^(abc){1,2}zz/ + abczz + 0: abczz + 1: abc + abcabczz + 0: abcabczz + 1: abc + *** Failers +No match + zz +No match + abcabcabczz +No match + >>abczz +No match + +/^(b+|a){1,2}c/ + bc + 0: bc + 1: b + bbc + 0: bbc + 1: bb + bbbc + 0: bbbc + 1: bbb + bac + 0: bac + 1: a + bbac + 0: bbac + 1: a + aac + 0: aac + 1: a + abbbbbbbbbbbc + 0: abbbbbbbbbbbc + 1: bbbbbbbbbbb + bbbbbbbbbbbac + 0: bbbbbbbbbbbac + 1: a + *** Failers +No match + aaac +No match + abbbbbbbbbbbac +No match + +/^[]cde]/ + ]thing + 0: ] + cthing + 0: c + dthing + 0: d + ething + 0: e + *** Failers +No match + athing +No match + fthing +No match + +/^[^]cde]/ + athing + 0: a + fthing + 0: f + *** Failers + 0: * + ]thing +No match + cthing +No match + dthing +No match + ething +No match + +/^[0-9]+$/ + 0 + 0: 0 + 1 + 0: 1 + 2 + 0: 2 + 3 + 0: 3 + 4 + 0: 4 + 5 + 0: 5 + 6 + 0: 6 + 7 + 0: 7 + 8 + 0: 8 + 9 + 0: 9 + 10 + 0: 10 + 100 + 0: 100 + *** Failers +No match + abc +No match + +/^.*nter/ + enter + 0: enter + inter + 0: inter + uponter + 0: uponter + +/^xxx[0-9]+$/ + xxx0 + 0: xxx0 + xxx1234 + 0: xxx1234 + *** Failers +No match + xxx +No match + +/^.+[0-9][0-9][0-9]$/ + x123 + 0: x123 + xx123 + 0: xx123 + 123456 + 0: 123456 + *** Failers +No match + 123 +No match + x1234 + 0: x1234 + +/^([^!]+)!(.+)=apquxz\.ixr\.zzz\.ac\.uk$/ + abc!pqr=apquxz.ixr.zzz.ac.uk + 0: abc!pqr=apquxz.ixr.zzz.ac.uk + 1: abc + 2: pqr + *** Failers +No match + !pqr=apquxz.ixr.zzz.ac.uk +No match + abc!=apquxz.ixr.zzz.ac.uk +No match + abc!pqr=apquxz:ixr.zzz.ac.uk +No match + abc!pqr=apquxz.ixr.zzz.ac.ukk +No match + +/:/ + Well, we need a colon: somewhere + 0: : + *** Fail if we don't +No match + +/([0-9a-f:]+)$/i + 0abc + 0: 0abc + 1: 0abc + abc + 0: abc + 1: abc + fed + 0: fed + 1: fed + E + 0: E + 1: E + :: + 0: :: + 1: :: + 5f03:12C0::932e + 0: 5f03:12C0::932e + 1: 5f03:12C0::932e + fed def + 0: def + 1: def + Any old stuff + 0: ff + 1: ff + *** Failers +No match + 0zzz +No match + gzzz +No match + Any old rubbish +No match + +/^.*\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})$/ + .1.2.3 + 0: .1.2.3 + 1: 1 + 2: 2 + 3: 3 + A.12.123.0 + 0: A.12.123.0 + 1: 12 + 2: 123 + 3: 0 + *** Failers +No match + .1.2.3333 +No match + 1.2.3 +No match + 1234.2.3 +No match + +/^([0-9]+)\s+IN\s+SOA\s+(\S+)\s+(\S+)\s*\(\s*$/ + 1 IN SOA non-sp1 non-sp2( + 0: 1 IN SOA non-sp1 non-sp2( + 1: 1 + 2: non-sp1 + 3: non-sp2 + 1 IN SOA non-sp1 non-sp2 ( + 0: 1 IN SOA non-sp1 non-sp2 ( + 1: 1 + 2: non-sp1 + 3: non-sp2 + *** Failers +No match + 1IN SOA non-sp1 non-sp2( +No match + +/^[a-zA-Z0-9][a-zA-Z0-9-]*(\.[a-zA-Z0-9][a-zA-z0-9-]*)*\.$/ + a. + 0: a. + Z. + 0: Z. + 2. + 0: 2. + ab-c.pq-r. + 0: ab-c.pq-r. + 1: .pq-r + sxk.zzz.ac.uk. + 0: sxk.zzz.ac.uk. + 1: .uk + x-.y-. + 0: x-.y-. + 1: .y- + *** Failers +No match + -abc.peq. +No match + +/^\*\.[a-z]([a-z0-9-]*[a-z0-9]+)?(\.[a-z]([a-z0-9-]*[a-z0-9]+)?)*$/ + *.a + 0: *.a + *.b0-a + 0: *.b0-a + 1: 0-a + *.c3-b.c + 0: *.c3-b.c + 1: 3-b + 2: .c + *.c-a.b-c + 0: *.c-a.b-c + 1: -a + 2: .b-c + 3: -c + *** Failers +No match + *.0 +No match + *.a- +No match + *.a-b.c- +No match + *.c-a.0-c +No match + +/^[0-9a-f](\.[0-9a-f])*$/i + a.b.c.d + 0: a.b.c.d + 1: .d + A.B.C.D + 0: A.B.C.D + 1: .D + a.b.c.1.2.3.C + 0: a.b.c.1.2.3.C + 1: .C + +/^".*"\s*(;.*)?$/ + "1234" + 0: "1234" + "abcd" ; + 0: "abcd" ; + 1: ; + "" ; rhubarb + 0: "" ; rhubarb + 1: ; rhubarb + *** Failers +No match + "1234" : things +No match + +/^(a(b(c)))(d(e(f)))(h(i(j)))(k(l(m)))$/ + abcdefhijklm + 0: abcdefhijklm + 1: abc + 2: bc + 3: c + 4: def + 5: ef + 6: f + 7: hij + 8: ij + 9: j +10: klm +11: lm +12: m + +/^a*\w/ + z + 0: z + az + 0: az + aaaz + 0: aaaz + a + 0: a + aa + 0: aa + aaaa + 0: aaaa + a+ + 0: a + aa+ + 0: aa + +/^a+\w/ + az + 0: az + aaaz + 0: aaaz + aa + 0: aa + aaaa + 0: aaaa + aa+ + 0: aa + +/^[0-9]{8}\w{2,}/ + 1234567890 + 0: 1234567890 + 12345678ab + 0: 12345678ab + 12345678__ + 0: 12345678__ + *** Failers +No match + 1234567 +No match + +/^[aeiou0-9]{4,5}$/ + uoie + 0: uoie + 1234 + 0: 1234 + 12345 + 0: 12345 + aaaaa + 0: aaaaa + *** Failers +No match + 123456 +No match + +/\`(abc|def)=(\1){2,3}\'/ + abc=abcabc + 0: abc=abcabc + 1: abc + 2: abc + def=defdefdef + 0: def=defdefdef + 1: def + 2: def + *** Failers +No match + abc=defdef +No match + +/(cat(a(ract|tonic)|erpillar)) \1()2(3)/ + cataract cataract23 + 0: cataract cataract23 + 1: cataract + 2: aract + 3: ract + 4: + 5: 3 + catatonic catatonic23 + 0: catatonic catatonic23 + 1: catatonic + 2: atonic + 3: tonic + 4: + 5: 3 + caterpillar caterpillar23 + 0: caterpillar caterpillar23 + 1: caterpillar + 2: erpillar + 3: <unset> + 4: + 5: 3 + + +/^From +([^ ]+) +[a-zA-Z][a-zA-Z][a-zA-Z] +[a-zA-Z][a-zA-Z][a-zA-Z] +[0-9]?[0-9] +[0-9][0-9]:[0-9][0-9]/ + From abcd Mon Sep 01 12:33:02 1997 + 0: From abcd Mon Sep 01 12:33 + 1: abcd + +/^From\s+\S+\s+([a-zA-Z]{3}\s+){2}[0-9]{1,2}\s+[0-9][0-9]:[0-9][0-9]/ + From abcd Mon Sep 01 12:33:02 1997 + 0: From abcd Mon Sep 01 12:33 + 1: Sep + From abcd Mon Sep 1 12:33:02 1997 + 0: From abcd Mon Sep 1 12:33 + 1: Sep + *** Failers +No match + From abcd Sep 01 12:33:02 1997 +No match + +/^(a)\1{2,3}(.)/ + aaab + 0: aaab + 1: a + 2: b + aaaab + 0: aaaab + 1: a + 2: b + aaaaab + 0: aaaaa + 1: a + 2: a + aaaaaab + 0: aaaaa + 1: a + 2: a + +/^[ab]{1,3}(ab*|b)/ + aabbbbb + 0: aabbbbb + 1: abbbbb + +/^(cow|)\1(bell)/ + cowcowbell + 0: cowcowbell + 1: cow + 2: bell + bell + 0: bell + 1: + 2: bell + *** Failers +No match + cowbell +No match + +/^(a|)\1+b/ + aab + 0: aab + 1: a + aaaab + 0: aaaab + 1: a + b + 0: b + 1: + *** Failers +No match + ab +No match + +/^(a|)\1{2}b/ + aaab + 0: aaab + 1: a + b + 0: b + 1: + *** Failers +No match + ab +No match + aab +No match + aaaab +No match + +/^(a|)\1{2,3}b/ + aaab + 0: aaab + 1: a + aaaab + 0: aaaab + 1: a + b + 0: b + 1: + *** Failers +No match + ab +No match + aab +No match + aaaaab +No match + +/ab{1,3}bc/ + abbbbc + 0: abbbbc + abbbc + 0: abbbc + abbc + 0: abbc + *** Failers +No match + abc +No match + abbbbbc +No match + +/([^.]*)\.([^:]*):[T ]+(.*)/ + track1.title:TBlah blah blah + 0: track1.title:TBlah blah blah + 1: track1 + 2: title + 3: Blah blah blah + +/([^.]*)\.([^:]*):[T ]+(.*)/i + track1.title:TBlah blah blah + 0: track1.title:TBlah blah blah + 1: track1 + 2: title + 3: Blah blah blah + +/([^.]*)\.([^:]*):[t ]+(.*)/i + track1.title:TBlah blah blah + 0: track1.title:TBlah blah blah + 1: track1 + 2: title + 3: Blah blah blah + +/^abc$/ + abc + 0: abc + *** Failers +No match + +/[-az]+/ + az- + 0: az- + *** Failers + 0: a + b +No match + +/[az-]+/ + za- + 0: za- + *** Failers + 0: a + b +No match + +/[a-z]+/ + abcdxyz + 0: abcdxyz + +/[0-9-]+/ + 12-34 + 0: 12-34 + *** Failers +No match + aaa +No match + +/(abc)\1/i + abcabc + 0: abcabc + 1: abc + ABCabc + 0: ABCabc + 1: ABC + abcABC + 0: abcABC + 1: abc + +/a{0}bc/ + bc + 0: bc + +/^([^a])([^b])([^c]*)([^d]{3,4})/ + baNOTccccd + 0: baNOTcccc + 1: b + 2: a + 3: NOT + 4: cccc + baNOTcccd + 0: baNOTccc + 1: b + 2: a + 3: NOT + 4: ccc + baNOTccd + 0: baNOTcc + 1: b + 2: a + 3: NO + 4: Tcc + bacccd + 0: baccc + 1: b + 2: a + 3: + 4: ccc + *** Failers + 0: *** Failers + 1: * + 2: * + 3: * Fail + 4: ers + anything +No match + baccd +No match + +/[^a]/ + Abc + 0: A + +/[^a]/i + Abc + 0: b + +/[^a]+/ + AAAaAbc + 0: AAA + +/[^a]+/i + AAAaAbc + 0: bc + +/[^k]$/ + abc + 0: c + *** Failers + 0: s + abk +No match + +/[^k]{2,3}$/ + abc + 0: abc + kbc + 0: bc + kabc + 0: abc + *** Failers + 0: ers + abk +No match + akb +No match + akk +No match + +/^[0-9]{8,}@.+[^k]$/ + 12345678@a.b.c.d + 0: 12345678@a.b.c.d + 123456789@x.y.z + 0: 123456789@x.y.z + *** Failers +No match + 12345678@x.y.uk +No match + 1234567@a.b.c.d +No match + +/(a)\1{8,}/ + aaaaaaaaa + 0: aaaaaaaaa + 1: a + aaaaaaaaaa + 0: aaaaaaaaaa + 1: a + *** Failers +No match + aaaaaaa +No match + +/[^a]/ + aaaabcd + 0: b + aaAabcd + 0: A + +/[^a]/i + aaaabcd + 0: b + aaAabcd + 0: b + +/[^az]/ + aaaabcd + 0: b + aaAabcd + 0: A + +/[^az]/i + aaaabcd + 0: b + aaAabcd + 0: b + +/P[^*]TAIRE[^*]{1,6}LL/ + xxxxxxxxxxxPSTAIREISLLxxxxxxxxx + 0: PSTAIREISLL + +/P[^*]TAIRE[^*]{1,}LL/ + xxxxxxxxxxxPSTAIREISLLxxxxxxxxx + 0: PSTAIREISLL + +/(\.[0-9][0-9][1-9]?)[0-9]+/ + 1.230003938 + 0: .230003938 + 1: .23 + 1.875000282 + 0: .875000282 + 1: .875 + 1.235 + 0: .235 + 1: .23 + +/\b(foo)\s+(\w+)/i + Food is on the foo table + 0: foo table + 1: foo + 2: table + +/foo(.*)bar/ + The food is under the bar in the barn. + 0: food is under the bar in the bar + 1: d is under the bar in the + +/(.*)([0-9]*)/ + I have 2 numbers: 53147 + 0: I have 2 numbers: 53147 + 1: I have 2 numbers: 53147 + 2: + +/(.*)([0-9]+)/ + I have 2 numbers: 53147 + 0: I have 2 numbers: 53147 + 1: I have 2 numbers: 5314 + 2: 7 + +/(.*)([0-9]+)$/ + I have 2 numbers: 53147 + 0: I have 2 numbers: 53147 + 1: I have 2 numbers: 5314 + 2: 7 + +/(.*)\b([0-9]+)$/ + I have 2 numbers: 53147 + 0: I have 2 numbers: 53147 + 1: I have 2 numbers: + 2: 53147 + +/(.*[^0-9])([0-9]+)$/ + I have 2 numbers: 53147 + 0: I have 2 numbers: 53147 + 1: I have 2 numbers: + 2: 53147 + +/[[:digit:]][[:digit:]]\/[[:digit:]][[:digit:]]\/[[:digit:]][[:digit:]][[:digit:]][[:digit:]]/ + 01/01/2000 + 0: 01/01/2000 + +/^(a){0,0}/ + bcd + 0: + abc + 0: + aab + 0: + +/^(a){0,1}/ + bcd + 0: + abc + 0: a + 1: a + aab + 0: a + 1: a + +/^(a){0,2}/ + bcd + 0: + abc + 0: a + 1: a + aab + 0: aa + 1: a + +/^(a){0,3}/ + bcd + 0: + abc + 0: a + 1: a + aab + 0: aa + 1: a + aaa + 0: aaa + 1: a + +/^(a){0,}/ + bcd + 0: + abc + 0: a + 1: a + aab + 0: aa + 1: a + aaa + 0: aaa + 1: a + aaaaaaaa + 0: aaaaaaaa + 1: a + +/^(a){1,1}/ + bcd +No match + abc + 0: a + 1: a + aab + 0: a + 1: a + +/^(a){1,2}/ + bcd +No match + abc + 0: a + 1: a + aab + 0: aa + 1: a + +/^(a){1,3}/ + bcd +No match + abc + 0: a + 1: a + aab + 0: aa + 1: a + aaa + 0: aaa + 1: a + +/^(a){1,}/ + bcd +No match + abc + 0: a + 1: a + aab + 0: aa + 1: a + aaa + 0: aaa + 1: a + aaaaaaaa + 0: aaaaaaaa + 1: a + +/^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]/ + 123456654321 + 0: 123456654321 + +/^[[:digit:]][[:digit:]][[:digit:]][[:digit:]][[:digit:]][[:digit:]][[:digit:]][[:digit:]][[:digit:]][[:digit:]][[:digit:]][[:digit:]]/ + 123456654321 + 0: 123456654321 + +/^[abc]{12}/ + abcabcabcabc + 0: abcabcabcabc + +/^[a-c]{12}/ + abcabcabcabc + 0: abcabcabcabc + +/^(a|b|c){12}/ + abcabcabcabc + 0: abcabcabcabc + 1: c + +/^[abcdefghijklmnopqrstuvwxy0123456789]/ + n + 0: n + *** Failers +No match + z +No match + +/abcde{0,0}/ + abcd + 0: abcd + *** Failers +No match + abce +No match + +/ab[cd]{0,0}e/ + abe + 0: abe + *** Failers +No match + abcde +No match + +/ab(c){0,0}d/ + abd + 0: abd + *** Failers +No match + abcd +No match + +/a(b*)/ + a + 0: a + 1: + ab + 0: ab + 1: b + abbbb + 0: abbbb + 1: bbbb + *** Failers + 0: a + 1: + bbbbb +No match + +/ab[0-9]{0}e/ + abe + 0: abe + *** Failers +No match + ab1e +No match + +/(A|B)*CD/ + CD + 0: CD + +/(AB)*\1/ + ABABAB + 0: ABABAB + 1: AB + +/([0-9]+)(\w)/ + 12345a + 0: 12345a + 1: 12345 + 2: a + 12345+ + 0: 12345 + 1: 1234 + 2: 5 + +/(abc|)+/ + abc + 0: abc + 1: abc + abcabc + 0: abcabc + 1: abc + abcabcabc + 0: abcabcabc + 1: abc + xyz + 0: + 1: + +/([a]*)*/ + a + 0: a + 1: a + aaaaa + 0: aaaaa + 1: aaaaa + +/([ab]*)*/ + a + 0: a + 1: a + b + 0: b + 1: b + ababab + 0: ababab + 1: ababab + aaaabcde + 0: aaaab + 1: aaaab + bbbb + 0: bbbb + 1: bbbb + +/([^a]*)*/ + b + 0: b + 1: b + bbbb + 0: bbbb + 1: bbbb + aaa + 0: + +/([^ab]*)*/ + cccc + 0: cccc + 1: cccc + abab + 0: + +/abc/ + abc + 0: abc + xabcy + 0: abc + ababc + 0: abc + *** Failers +No match + xbc +No match + axc +No match + abx +No match + +/ab*c/ + abc + 0: abc + +/ab*bc/ + abc + 0: abc + abbc + 0: abbc + abbbbc + 0: abbbbc + +/.{1}/ + abbbbc + 0: a + +/.{3,4}/ + abbbbc + 0: abbb + +/ab{0,}bc/ + abbbbc + 0: abbbbc + +/ab+bc/ + abbc + 0: abbc + *** Failers +No match + abc +No match + abq +No match + +/ab+bc/ + abbbbc + 0: abbbbc + +/ab{1,}bc/ + abbbbc + 0: abbbbc + +/ab{1,3}bc/ + abbbbc + 0: abbbbc + +/ab{3,4}bc/ + abbbbc + 0: abbbbc + +/ab{4,5}bc/ + *** Failers +No match + abq +No match + abbbbc +No match + +/ab?bc/ + abbc + 0: abbc + abc + 0: abc + +/ab{0,1}bc/ + abc + 0: abc + +/ab?c/ + abc + 0: abc + +/ab{0,1}c/ + abc + 0: abc + +/^abc$/ + abc + 0: abc + *** Failers +No match + abbbbc +No match + abcc +No match + +/^abc/ + abcc + 0: abc + +/abc$/ + aabc + 0: abc + *** Failers +No match + aabc + 0: abc + aabcd +No match + +/^/ + abc + 0: + +/$/ + abc + 0: + +/a.c/ + abc + 0: abc + axc + 0: axc + +/a.*c/ + axyzc + 0: axyzc + +/a[bc]d/ + abd + 0: abd + *** Failers +No match + axyzd +No match + abc +No match + +/a[b-d]e/ + ace + 0: ace + +/a[b-d]/ + aac + 0: ac + +/a[-b]/ + a- + 0: a- + +/a[b-]/ + a- + 0: a- + +/a[]]b/ + a]b + 0: a]b + +/a[^bc]d/ + aed + 0: aed + *** Failers +No match + abd +No match + abd +No match + +/a[^-b]c/ + adc + 0: adc + +/a[^]b]c/ + adc + 0: adc + *** Failers +No match + a-c + 0: a-c + a]c +No match + +/\ba\b/ + a- + 0: a + -a + 0: a + -a- + 0: a + +/\by\b/ + *** Failers +No match + xy +No match + yz +No match + xyz +No match + +/\Ba\B/ + *** Failers + 0: a + a- +No match + -a +No match + -a- +No match + +/\By\b/ + xy + 0: y + +/\by\B/ + yz + 0: y + +/\By\B/ + xyz + 0: y + +/\w/ + a + 0: a + +/\W/ + - + 0: - + *** Failers + 0: * + - + 0: - + a +No match + +/a\sb/ + a b + 0: a b + +/a\Sb/ + a-b + 0: a-b + *** Failers +No match + a-b + 0: a-b + a b +No match + +/[0-9]/ + 1 + 0: 1 + +/[^0-9]/ + - + 0: - + *** Failers + 0: * + - + 0: - + 1 +No match + +/ab|cd/ + abc + 0: ab + abcd + 0: ab + +/()ef/ + def + 0: ef + 1: + +/a\(b/ + a(b + 0: a(b + +/a\(*b/ + ab + 0: ab + a((b + 0: a((b + +/((a))/ + abc + 0: a + 1: a + 2: a + +/(a)b(c)/ + abc + 0: abc + 1: a + 2: c + +/a+b+c/ + aabbabc + 0: abc + +/a{1,}b{1,}c/ + aabbabc + 0: abc + +/(a+|b)*/ + ab + 0: ab + 1: b + +/(a+|b){0,}/ + ab + 0: ab + 1: b + +/(a+|b)+/ + ab + 0: ab + 1: b + +/(a+|b){1,}/ + ab + 0: ab + 1: b + +/(a+|b)?/ + ab + 0: a + 1: a + +/(a+|b){0,1}/ + ab + 0: a + 1: a + +/[^ab]*/ + cde + 0: cde + +/abc/ + *** Failers +No match + b +No match + + +/a*/ + + +/([abc])*d/ + abbbcd + 0: abbbcd + 1: c + +/([abc])*bcd/ + abcd + 0: abcd + 1: a + +/a|b|c|d|e/ + e + 0: e + +/(a|b|c|d|e)f/ + ef + 0: ef + 1: e + +/abcd*efg/ + abcdefg + 0: abcdefg + +/ab*/ + xabyabbbz + 0: ab + xayabbbz + 0: a + +/(ab|cd)e/ + abcde + 0: cde + 1: cd + +/[abhgefdc]ij/ + hij + 0: hij + +/(abc|)ef/ + abcdef + 0: ef + 1: + +/(a|b)c*d/ + abcd + 0: bcd + 1: b + +/(ab|ab*)bc/ + abc + 0: abc + 1: a + +/a([bc]*)c*/ + abc + 0: abc + 1: bc + +/a([bc]*)(c*d)/ + abcd + 0: abcd + 1: bc + 2: d + +/a([bc]+)(c*d)/ + abcd + 0: abcd + 1: bc + 2: d + +/a([bc]*)(c+d)/ + abcd + 0: abcd + 1: b + 2: cd + +/a[bcd]*dcdcde/ + adcdcde + 0: adcdcde + +/a[bcd]+dcdcde/ + *** Failers +No match + abcde +No match + adcdcde +No match + +/(ab|a)b*c/ + abc + 0: abc + 1: ab + +/((a)(b)c)(d)/ + abcd + 0: abcd + 1: abc + 2: a + 3: b + 4: d + +/[a-zA-Z_][a-zA-Z0-9_]*/ + alpha + 0: alpha + +/^a(bc+|b[eh])g|.h$/ + abh + 0: bh + +/(bc+d$|ef*g.|h?i(j|k))/ + effgz + 0: effgz + 1: effgz + ij + 0: ij + 1: ij + 2: j + reffgz + 0: effgz + 1: effgz + *** Failers +No match + effg +No match + bcdd +No match + +/((((((((((a))))))))))/ + a + 0: a + 1: a + 2: a + 3: a + 4: a + 5: a + 6: a + 7: a + 8: a + 9: a +10: a + +/((((((((((a))))))))))\9/ + aa + 0: aa + 1: a + 2: a + 3: a + 4: a + 5: a + 6: a + 7: a + 8: a + 9: a +10: a + +/(((((((((a)))))))))/ + a + 0: a + 1: a + 2: a + 3: a + 4: a + 5: a + 6: a + 7: a + 8: a + 9: a + +/multiple words of text/ + *** Failers +No match + aa +No match + uh-uh +No match + +/multiple words/ + multiple words, yeah + 0: multiple words + +/(.*)c(.*)/ + abcde + 0: abcde + 1: ab + 2: de + +/\((.*), (.*)\)/ + (a, b) + 0: (a, b) + 1: a + 2: b + +/abcd/ + abcd + 0: abcd + +/a(bc)d/ + abcd + 0: abcd + 1: bc + +/a[-]?c/ + ac + 0: ac + +/(abc)\1/ + abcabc + 0: abcabc + 1: abc + +/([a-c]*)\1/ + abcabc + 0: abcabc + 1: abc + +/(a)|\1/ + a + 0: a + 1: a + *** Failers + 0: a + 1: a + ab + 0: a + 1: a + x +No match + +/abc/i + ABC + 0: ABC + XABCY + 0: ABC + ABABC + 0: ABC + *** Failers +No match + aaxabxbaxbbx +No match + XBC +No match + AXC +No match + ABX +No match + +/ab*c/i + ABC + 0: ABC + +/ab*bc/i + ABC + 0: ABC + ABBC + 0: ABBC + +/ab+bc/i + *** Failers +No match + ABC +No match + ABQ +No match + +/ab+bc/i + ABBBBC + 0: ABBBBC + +/^abc$/i + ABC + 0: ABC + *** Failers +No match + ABBBBC +No match + ABCC +No match + +/^abc/i + ABCC + 0: ABC + +/abc$/i + AABC + 0: ABC + +/^/i + ABC + 0: + +/$/i + ABC + 0: + +/a.c/i + ABC + 0: ABC + AXC + 0: AXC + +/a.*c/i + *** Failers +No match + AABC + 0: AABC + AXYZD +No match + +/a[bc]d/i + ABD + 0: ABD + +/a[b-d]e/i + ACE + 0: ACE + *** Failers +No match + ABC +No match + ABD +No match + +/a[b-d]/i + AAC + 0: AC + +/a[-b]/i + A- + 0: A- + +/a[b-]/i + A- + 0: A- + +/a[]]b/i + A]B + 0: A]B + +/a[^bc]d/i + AED + 0: AED + +/a[^-b]c/i + ADC + 0: ADC + *** Failers +No match + ABD +No match + A-C +No match + +/a[^]b]c/i + ADC + 0: ADC + +/ab|cd/i + ABC + 0: AB + ABCD + 0: AB + +/()ef/i + DEF + 0: EF + 1: + +/$b/i + *** Failers +No match + A]C +No match + B +No match + +/a\(b/i + A(B + 0: A(B + +/a\(*b/i + AB + 0: AB + A((B + 0: A((B + +/((a))/i + ABC + 0: A + 1: A + 2: A + +/(a)b(c)/i + ABC + 0: ABC + 1: A + 2: C + +/a+b+c/i + AABBABC + 0: ABC + +/a{1,}b{1,}c/i + AABBABC + 0: ABC + +/(a+|b)*/i + AB + 0: AB + 1: B + +/(a+|b){0,}/i + AB + 0: AB + 1: B + +/(a+|b)+/i + AB + 0: AB + 1: B + +/(a+|b){1,}/i + AB + 0: AB + 1: B + +/(a+|b)?/i + AB + 0: A + 1: A + +/(a+|b){0,1}/i + AB + 0: A + 1: A + +/[^ab]*/i + CDE + 0: CDE + +/([abc])*d/i + ABBBCD + 0: ABBBCD + 1: C + +/([abc])*bcd/i + ABCD + 0: ABCD + 1: A + +/a|b|c|d|e/i + E + 0: E + +/(a|b|c|d|e)f/i + EF + 0: EF + 1: E + +/abcd*efg/i + ABCDEFG + 0: ABCDEFG + +/ab*/i + XABYABBBZ + 0: AB + XAYABBBZ + 0: A + +/(ab|cd)e/i + ABCDE + 0: CDE + 1: CD + +/[abhgefdc]ij/i + HIJ + 0: HIJ + +/^(ab|cd)e/i + ABCDE +No match + +/(abc|)ef/i + ABCDEF + 0: EF + 1: + +/(a|b)c*d/i + ABCD + 0: BCD + 1: B + +/(ab|ab*)bc/i + ABC + 0: ABC + 1: A + +/a([bc]*)c*/i + ABC + 0: ABC + 1: BC + +/a([bc]*)(c*d)/i + ABCD + 0: ABCD + 1: BC + 2: D + +/a([bc]+)(c*d)/i + ABCD + 0: ABCD + 1: BC + 2: D + +/a([bc]*)(c+d)/i + ABCD + 0: ABCD + 1: B + 2: CD + +/a[bcd]*dcdcde/i + ADCDCDE + 0: ADCDCDE + +/a[bcd]+dcdcde/i + +/(ab|a)b*c/i + ABC + 0: ABC + 1: AB + +/((a)(b)c)(d)/i + ABCD + 0: ABCD + 1: ABC + 2: A + 3: B + 4: D + +/[a-zA-Z_][a-zA-Z0-9_]*/i + ALPHA + 0: ALPHA + +/^a(bc+|b[eh])g|.h$/i + ABH + 0: BH + +/(bc+d$|ef*g.|h?i(j|k))/i + EFFGZ + 0: EFFGZ + 1: EFFGZ + IJ + 0: IJ + 1: IJ + 2: J + REFFGZ + 0: EFFGZ + 1: EFFGZ + *** Failers +No match + ADCDCDE +No match + EFFG +No match + BCDD +No match + +/((((((((((a))))))))))/i + A + 0: A + 1: A + 2: A + 3: A + 4: A + 5: A + 6: A + 7: A + 8: A + 9: A +10: A + +/((((((((((a))))))))))\9/i + AA + 0: AA + 1: A + 2: A + 3: A + 4: A + 5: A + 6: A + 7: A + 8: A + 9: A +10: A + +/(((((((((a)))))))))/i + A + 0: A + 1: A + 2: A + 3: A + 4: A + 5: A + 6: A + 7: A + 8: A + 9: A + +/multiple words of text/i + *** Failers +No match + AA +No match + UH-UH +No match + +/multiple words/i + MULTIPLE WORDS, YEAH + 0: MULTIPLE WORDS + +/(.*)c(.*)/i + ABCDE + 0: ABCDE + 1: AB + 2: DE + +/\((.*), (.*)\)/i + (A, B) + 0: (A, B) + 1: A + 2: B + +/abcd/i + ABCD + 0: ABCD + +/a(bc)d/i + ABCD + 0: ABCD + 1: BC + +/a[-]?c/i + AC + 0: AC + +/(abc)\1/i + ABCABC + 0: ABCABC + 1: ABC + +/([a-c]*)\1/i + ABCABC + 0: ABCABC + 1: ABC + +/((foo)|(bar))*/ + foobar + 0: foobar + 1: bar + 2: foo + 3: bar + +/^(.+)?B/ + AB + 0: AB + 1: A + +/^([^a-z])|(\^)$/ + . + 0: . + 1: . + +/^[<>]&/ + <&OUT + 0: <& + +/^(){3,5}/ + abc + 0: + 1: + +/^(a+)*ax/ + aax + 0: aax + 1: a + +/^((a|b)+)*ax/ + aax + 0: aax + 1: a + 2: a + +/^((a|bc)+)*ax/ + aax + 0: aax + 1: a + 2: a + +/(a|x)*ab/ + cab + 0: ab + +/(a)*ab/ + cab + 0: ab + +/(ab)[0-9]\1/i + Ab4ab + 0: Ab4ab + 1: Ab + ab4Ab + 0: ab4Ab + 1: ab + +/foo\w*[0-9]{4}baz/ + foobar1234baz + 0: foobar1234baz + +/(\w+:)+/ + one: + 0: one: + 1: one: + +/((\w|:)+::)?(\w+)$/ + abcd + 0: abcd + 1: <unset> + 2: <unset> + 3: abcd + xy:z:::abcd + 0: xy:z:::abcd + 1: xy:z::: + 2: : + 3: abcd + +/^[^bcd]*(c+)/ + aexycd + 0: aexyc + 1: c + +/(a*)b+/ + caab + 0: aab + 1: aa + +/((\w|:)+::)?(\w+)$/ + abcd + 0: abcd + 1: <unset> + 2: <unset> + 3: abcd + xy:z:::abcd + 0: xy:z:::abcd + 1: xy:z::: + 2: : + 3: abcd + *** Failers + 0: Failers + 1: <unset> + 2: <unset> + 3: Failers + abcd: +No match + abcd: +No match + +/^[^bcd]*(c+)/ + aexycd + 0: aexyc + 1: c + +/((Z)+|A)*/ + ZABCDEFG + 0: ZA + 1: A + 2: Z + +/(Z()|A)*/ + ZABCDEFG + 0: ZA + 1: A + 2: + +/(Z(())|A)*/ + ZABCDEFG + 0: ZA + 1: A + 2: + 3: + +/(.*)[0-9]+\1/ + abc123abc + 0: abc123abc + 1: abc + abc123bc + 0: bc123bc + 1: bc + +/((.*))[0-9]+\1/ + abc123abc + 0: abc123abc + 1: abc + 2: abc + abc123bc + 0: bc123bc + 1: bc + 2: bc + +/^a{2,5}$/ + aa + 0: aa + aaa + 0: aaa + aaaa + 0: aaaa + aaaaa + 0: aaaaa + *** Failers +No match + a +No match + b +No match + aaaaab +No match + aaaaaa diff --git a/test/src/regex-resources/PTESTS b/test/src/regex-resources/PTESTS new file mode 100644 index 00000000000..68acc314d37 --- /dev/null +++ b/test/src/regex-resources/PTESTS @@ -0,0 +1,341 @@ +# 2.8.2 Regular Expression General Requirement +2¦4¦bb*¦abbbc¦ +2¦2¦bb*¦ababbbc¦ +7¦9¦A#*::¦A:A#:qA::qA#::qA##::q¦ +1¦5¦A#*::¦A##::A#::qA::qA#:q¦ +# 2.8.3.1.2 BRE Special Characters +# GA108 +2¦2¦\.¦a.c¦ +2¦2¦\[¦a[c¦ +2¦2¦\\¦a\c¦ +2¦2¦\*¦a*c¦ +2¦2¦\^¦a^c¦ +2¦2¦\$¦a$c¦ +7¦11¦X\*Y\*8¦Y*8X*8X*Y*8¦ +# GA109 +2¦2¦[.]¦a.c¦ +2¦2¦[[]¦a[c¦ +-1¦-1¦[[]¦ac¦ +2¦2¦[\]¦a\c¦ +1¦1¦[\a]¦abc¦ +2¦2¦[\.]¦a\.c¦ +2¦2¦[\.]¦a.\c¦ +2¦2¦[*]¦a*c¦ +2¦2¦[$]¦a$c¦ +2¦2¦[X*Y8]¦7*8YX¦ +# GA110 +2¦2¦*¦a*c¦ +3¦4¦*a¦*b*a*c¦ +1¦5¦**9=¦***9=9¦ +# GA111 +1¦1¦^*¦*bc¦ +-1¦-1¦^*¦a*c¦ +-1¦-1¦^*¦^*ab¦ +1¦5¦^**9=¦***9=¦ +-1¦-1¦^*5<*9¦5<9*5<*9¦ +# GA112 +2¦3¦\(*b\)¦a*b¦ +-1¦-1¦\(*b\)¦ac¦ +1¦6¦A\(**9\)=¦A***9=79¦ +# GA113(1) +1¦3¦\(^*ab\)¦*ab¦ +-1¦-1¦\(^*ab\)¦^*ab¦ +-1¦-1¦\(^*b\)¦a*b¦ +-1¦-1¦\(^*b\)¦^*b¦ +### GA113(2) GNU regex implements GA113(1) +##-1¦-1¦\(^*ab\)¦*ab¦ +##-1¦-1¦\(^*ab\)¦^*ab¦ +##1¦1¦\(^*b\)¦b¦ +##1¦3¦\(^*b\)¦^^b¦ +# GA114 +1¦3¦a^b¦a^b¦ +1¦3¦a\^b¦a^b¦ +1¦1¦^^¦^bc¦ +2¦2¦\^¦a^c¦ +1¦1¦[c^b]¦^abc¦ +1¦1¦[\^ab]¦^ab¦ +2¦2¦[\^ab]¦c\d¦ +-1¦-1¦[^^]¦^¦ +1¦3¦\(a^b\)¦a^b¦ +1¦3¦\(a\^b\)¦a^b¦ +2¦2¦\(\^\)¦a^b¦ +# GA115 +3¦3¦$$¦ab$¦ +-1¦-1¦$$¦$ab¦ +2¦3¦$c¦a$c¦ +2¦2¦[$]¦a$c¦ +1¦2¦\$a¦$a¦ +3¦3¦\$$¦ab$¦ +2¦6¦A\([34]$[34]\)B¦XA4$3BY¦ +# 2.8.3.1.3 Periods in BREs +# GA116 +1¦1¦.¦abc¦ +-1¦-1¦.ab¦abc¦ +1¦3¦ab.¦abc¦ +1¦3¦a.b¦a,b¦ +-1¦-1¦.......¦PqRs6¦ +1¦7¦.......¦PqRs6T8¦ +# 2.8.3.2 RE Bracket Expression +# GA118 +2¦2¦[abc]¦xbyz¦ +-1¦-1¦[abc]¦xyz¦ +2¦2¦[abc]¦xbay¦ +# GA119 +2¦2¦[^a]¦abc¦ +4¦4¦[^]cd]¦cd]ef¦ +2¦2¦[^abc]¦axyz¦ +-1¦-1¦[^abc]¦abc¦ +3¦3¦[^[.a.]b]¦abc¦ +3¦3¦[^[=a=]b]¦abc¦ +2¦2¦[^-ac]¦abcde-¦ +2¦2¦[^ac-]¦abcde-¦ +3¦3¦[^a-b]¦abcde¦ +3¦3¦[^a-bd-e]¦dec¦ +2¦2¦[^---]¦-ab¦ +16¦16¦[^a-zA-Z0-9]¦pqrstVWXYZ23579#¦ +# GA120(1) +3¦3¦[]a]¦cd]ef¦ +1¦1¦[]-a]¦a_b¦ +3¦3¦[][.-.]-0]¦ab0-]¦ +1¦1¦[]^a-z]¦string¦ +# GA120(2) +4¦4¦[^]cd]¦cd]ef¦ +0¦0¦[^]]*¦]]]]]]]]X¦ +0¦0¦[^]]*¦]]]]]]]]¦ +9¦9¦[^]]\{1,\}¦]]]]]]]]X¦ +-1¦-1¦[^]]\{1,\}¦]]]]]]]]¦ +# GA120(3) +3¦3¦[c[.].]d]¦ab]cd¦ +2¦8¦[a-z]*[[.].]][A-Z]*¦Abcd]DEFg¦ +# GA121 +2¦2¦[[.a.]b]¦Abc¦ +1¦1¦[[.a.]b]¦aBc¦ +-1¦-1¦[[.a.]b]¦ABc¦ +3¦3¦[^[.a.]b]¦abc¦ +3¦3¦[][.-.]-0]¦ab0-]¦ +3¦3¦[A-[.].]c]¦ab]!¦ +# GA122 +-2¦-2¦[[.ch.]]¦abc¦ +-2¦-2¦[[.ab.][.CD.][.EF.]]¦yZabCDEFQ9¦ +# GA125 +2¦2¦[[=a=]b]¦Abc¦ +1¦1¦[[=a=]b]¦aBc¦ +-1¦-1¦[[=a=]b]¦ABc¦ +3¦3¦[^[=a=]b]¦abc¦ +# GA126 +#W the expected result for [[:alnum:]]* is 2-7 which is wrong +0¦0¦[[:alnum:]]*¦ aB28gH¦ +2¦7¦[[:alnum:]][[:alnum:]]*¦ aB28gH¦ +#W the expected result for [^[:alnum:]]* is 2-5 which is wrong +0¦0¦[^[:alnum:]]*¦2 ,a¦ +2¦5¦[^[:alnum:]][^[:alnum:]]*¦2 ,a¦ +#W the expected result for [[:alpha:]]* is 2-5 which is wrong +0¦0¦[[:alpha:]]*¦ aBgH2¦ +2¦5¦[[:alpha:]][[:alpha:]]*¦ aBgH2¦ +1¦6¦[^[:alpha:]]*¦2 8,a¦ +1¦2¦[[:blank:]]*¦
¦ +1¦8¦[^[:blank:]]*¦aB28gH, ¦ +1¦2¦[[:cntrl:]]*¦ ¦ +1¦8¦[^[:cntrl:]]*¦aB2 8gh,¦ +#W the expected result for [[:digit:]]* is 2-3 which is wrong +0¦0¦[[:digit:]]*¦a28¦ +2¦3¦[[:digit:]][[:digit:]]*¦a28¦ +1¦8¦[^[:digit:]]*¦aB gH,¦ +1¦7¦[[:graph:]]*¦aB28gH, ¦ +1¦3¦[^[:graph:]]*¦ ,¦ +1¦2¦[[:lower:]]*¦agB¦ +1¦8¦[^[:lower:]]*¦B2 8H,a¦ +1¦8¦[[:print:]]*¦aB2 8gH, ¦ +1¦2¦[^[:print:]]*¦ ¦ +#W the expected result for [[:punct:]]* is 2-2 which is wrong +0¦0¦[[:punct:]]*¦a,2¦ +2¦3¦[[:punct:]][[:punct:]]*¦a,,2¦ +1¦9¦[^[:punct:]]*¦aB2 8gH¦ +1¦3¦[[:space:]]*¦
¦ +#W the expected result for [^[:space:]]* is 2-9 which is wrong +0¦0¦[^[:space:]]*¦ aB28gH, ¦ +2¦9¦[^[:space:]][^[:space:]]*¦ aB28gH, ¦ +#W the expected result for [[:upper:]]* is 2-3 which is wrong +0¦0¦[[:upper:]]*¦aBH2¦ +2¦3¦[[:upper:]][[:upper:]]*¦aBH2¦ +1¦8¦[^[:upper:]]*¦a2 8g,B¦ +#W the expected result for [[:xdigit:]]* is 2-5 which is wrong +0¦0¦[[:xdigit:]]*¦gaB28h¦ +2¦5¦[[:xdigit:]][[:xdigit:]]*¦gaB28h¦ +#W the expected result for [^[:xdigit:]]* is 2-7 which is wrong +2¦7¦[^[:xdigit:]][^[:xdigit:]]*¦a gH,2¦ +# GA127 +-2¦-2¦[b-a]¦abc¦ +1¦1¦[a-c]¦bbccde¦ +2¦2¦[a-b]¦-bc¦ +3¦3¦[a-z0-9]¦AB0¦ +3¦3¦[^a-b]¦abcde¦ +3¦3¦[^a-bd-e]¦dec¦ +1¦1¦[]-a]¦a_b¦ +2¦2¦[+--]¦a,b¦ +2¦2¦[--/]¦a.b¦ +2¦2¦[^---]¦-ab¦ +3¦3¦[][.-.]-0]¦ab0-]¦ +3¦3¦[A-[.].]c]¦ab]!¦ +2¦6¦bc[d-w]xy¦abchxyz¦ +# GA129 +1¦1¦[a-cd-f]¦dbccde¦ +-1¦-1¦[a-ce-f]¦dBCCdE¦ +2¦4¦b[n-zA-M]Y¦absY9Z¦ +2¦4¦b[n-zA-M]Y¦abGY9Z¦ +# GA130 +3¦3¦[-xy]¦ac-¦ +2¦4¦c[-xy]D¦ac-D+¦ +2¦2¦[--/]¦a.b¦ +2¦4¦c[--/]D¦ac.D+b¦ +2¦2¦[^-ac]¦abcde-¦ +1¦3¦a[^-ac]c¦abcde-¦ +3¦3¦[xy-]¦zc-¦ +2¦4¦c[xy-]7¦zc-786¦ +2¦2¦[^ac-]¦abcde-¦ +2¦4¦a[^ac-]c¦5abcde-¦ +2¦2¦[+--]¦a,b¦ +2¦4¦a[+--]B¦Xa,By¦ +2¦2¦[^---]¦-ab¦ +4¦6¦X[^---]Y¦X-YXaYXbY¦ +# 2.8.3.3 BREs Matching Multiple Characters +# GA131 +3¦4¦cd¦abcdeabcde¦ +1¦2¦ag*b¦abcde¦ +-1¦-1¦[a-c][e-f]¦abcdef¦ +3¦4¦[a-c][e-f]¦acbedf¦ +4¦8¦abc*XYZ¦890abXYZ#*¦ +4¦9¦abc*XYZ¦890abcXYZ#*¦ +4¦15¦abc*XYZ¦890abcccccccXYZ#*¦ +-1¦-1¦abc*XYZ¦890abc*XYZ#*¦ +# GA132 +2¦4¦\(*bc\)¦a*bc¦ +1¦2¦\(ab\)¦abcde¦ +1¦10¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)¦abcdefghijk¦ +3¦8¦43\(2\(6\)*0\)AB¦654320ABCD¦ +3¦9¦43\(2\(7\)*0\)AB¦6543270ABCD¦ +3¦12¦43\(2\(7\)*0\)AB¦6543277770ABCD¦ +# GA133 +1¦10¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)¦abcdefghijk¦ +-1¦-1¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(k\)\)\)\)\)\)\)\)¦abcdefghijk¦ +# GA134 +2¦4¦\(bb*\)¦abbbc¦ +2¦2¦\(bb*\)¦ababbbc¦ +1¦6¦a\(.*b\)¦ababbbc¦ +1¦2¦a\(b*\)¦ababbbc¦ +1¦20¦a\(.*b\)c¦axcaxbbbcsxbbbbbbbbc¦ +# GA135 +1¦7¦\(a\(b\(c\(d\(e\)\)\)\)\)\4¦abcdededede¦ +#W POSIX does not really specify whether a\(b\)*c\1 matches acb. +#W back references are supposed to expand to the last match, but what +#W if there never was a match as in this case? +-1¦-1¦a\(b\)*c\1¦acb¦ +1¦11¦\(a\(b\(c\(d\(e\(f\(g\)h\(i\(j\)\)\)\)\)\)\)\)\9¦abcdefghijjk¦ +# GA136 +#W These two tests have the same problem as the test in GA135. No match +#W of a subexpression, why should the back reference be usable? +#W 1 2 a\(b\)*c\1 acb +#W 4 7 a\(b\(c\(d\(f\)*\)\)\)\4¦xYzabcdePQRST +-1¦-1¦a\(b\)*c\1¦acb¦ +-1¦-1¦a\(b\(c\(d\(f\)*\)\)\)\4¦xYzabcdePQRST¦ +# GA137 +-2¦-2¦\(a\(b\)\)\3¦foo¦ +-2¦-2¦\(a\(b\)\)\(a\(b\)\)\5¦foo¦ +# GA138 +1¦2¦ag*b¦abcde¦ +1¦10¦a.*b¦abababvbabc¦ +2¦5¦b*c¦abbbcdeabbbbbbcde¦ +2¦5¦bbb*c¦abbbcdeabbbbbbcde¦ +1¦5¦a\(b\)*c\1¦abbcbbb¦ +-1¦-1¦a\(b\)*c\1¦abbdbd¦ +0¦0¦\([a-c]*\)\1¦abcacdef¦ +1¦6¦\([a-c]*\)\1¦abcabcabcd¦ +1¦2¦a^*b¦ab¦ +1¦5¦a^*b¦a^^^b¦ +# GA139 +1¦2¦a\{2\}¦aaaa¦ +1¦7¦\([a-c]*\)\{0,\}¦aabcaab¦ +1¦2¦\(a\)\1\{1,2\}¦aabc¦ +1¦3¦\(a\)\1\{1,2\}¦aaaabc¦ +#W the expression \(\(a\)\1\)\{1,2\} is ill-formed, using \2 +1¦4¦\(\(a\)\2\)\{1,2\}¦aaaabc¦ +# GA140 +1¦2¦a\{2\}¦aaaa¦ +-1¦-1¦a\{2\}¦abcd¦ +0¦0¦a\{0\}¦aaaa¦ +1¦64¦a\{64\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ +# GA141 +1¦7¦\([a-c]*\)\{0,\}¦aabcaab¦ +#W the expected result for \([a-c]*\)\{2,\} is failure which isn't correct +1¦3¦\([a-c]*\)\{2,\}¦abcdefg¦ +1¦3¦\([a-c]*\)\{1,\}¦abcdefg¦ +-1¦-1¦a\{64,\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ +# GA142 +1¦3¦a\{2,3\}¦aaaa¦ +-1¦-1¦a\{2,3\}¦abcd¦ +0¦0¦\([a-c]*\)\{0,0\}¦foo¦ +1¦63¦a\{1,63\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦ +# 2.8.3.4 BRE Precedence +# GA143 +#W There are numerous bugs in the original version. +2¦19¦\^\[[[.].]]\\(\\1\\)\*\\{1,2\\}\$¦a^[]\(\1\)*\{1,2\}$b¦ +1¦6¦[[=*=]][[=\=]][[=]=]][[===]][[...]][[:punct:]]¦*\]=.;¦ +1¦6¦[$\(*\)^]*¦$\()*^¦ +1¦1¦[\1]¦1¦ +1¦1¦[\{1,2\}]¦{¦ +#W the expected result for \(*\)*\1* is 2-2 which isn't correct +0¦0¦\(*\)*\1*¦a*b*11¦ +2¦3¦\(*\)*\1*b¦a*b*11¦ +#W the expected result for \(a\(b\{1,2\}\)\{1,2\}\) is 1-5 which isn't correct +1¦3¦\(a\(b\{1,2\}\)\{1,2\}\)¦abbab¦ +1¦5¦\(a\(b\{1,2\}\)\)\{1,2\}¦abbab¦ +1¦1¦^\(^\(^a$\)$\)$¦a¦ +1¦2¦\(a\)\1$¦aa¦ +1¦3¦ab*¦abb¦ +1¦4¦ab\{2,4\}¦abbbc¦ +# 2.8.3.5 BRE Expression Anchoring +# GA144 +1¦1¦^a¦abc¦ +-1¦-1¦^b¦abc¦ +-1¦-1¦^[a-zA-Z]¦99Nine¦ +1¦4¦^[a-zA-Z]*¦Nine99¦ +# GA145(1) +1¦2¦\(^a\)\1¦aabc¦ +-1¦-1¦\(^a\)\1¦^a^abc¦ +1¦2¦\(^^a\)¦^a¦ +1¦1¦\(^^\)¦^^¦ +1¦3¦\(^abc\)¦abcdef¦ +-1¦-1¦\(^def\)¦abcdef¦ +### GA145(2) GNU regex implements GA145(1) +##-1¦-1¦\(^a\)\1¦aabc¦ +##1¦4¦\(^a\)\1¦^a^abc¦ +##-1¦-1¦\(^^a\)¦^a¦ +##1¦2¦\(^^\)¦^^¦ +# GA146 +3¦3¦a$¦cba¦ +-1¦-1¦a$¦abc¦ +5¦7¦[a-z]*$¦99ZZxyz¦ +#W the expected result for [a-z]*$ is failure which isn't correct +10¦9¦[a-z]*$¦99ZZxyz99¦ +3¦3¦$$¦ab$¦ +-1¦-1¦$$¦$ab¦ +3¦3¦\$$¦ab$¦ +# GA147(1) +-1¦-1¦\(a$\)\1¦bcaa¦ +-1¦-1¦\(a$\)\1¦ba$¦ +-1¦-1¦\(ab$\)¦ab$¦ +1¦2¦\(ab$\)¦ab¦ +4¦6¦\(def$\)¦abcdef¦ +-1¦-1¦\(abc$\)¦abcdef¦ +### GA147(2) GNU regex implements GA147(1) +##-1¦-1¦\(a$\)\1¦bcaa¦ +##2¦5¦\(a$\)\1¦ba$a$¦ +##-1¦-1¦\(ab$\)¦ab¦ +##1¦3¦\(ab$\)¦ab$¦ +# GA148 +0¦0¦^$¦¦ +1¦3¦^abc$¦abc¦ +-1¦-1¦^xyz$¦^xyz^¦ +-1¦-1¦^234$¦^234$¦ +1¦9¦^[a-zA-Z0-9]*$¦2aA3bB9zZ¦ +-1¦-1¦^[a-z0-9]*$¦2aA3b#B9zZ¦ diff --git a/test/src/regex-resources/TESTS b/test/src/regex-resources/TESTS new file mode 100644 index 00000000000..f2c98864058 --- /dev/null +++ b/test/src/regex-resources/TESTS @@ -0,0 +1,167 @@ +0:(.*)*\1:xx +0:^: +0:$: +0:^$: +0:^a$:a +0:abc:abc +1:abc:xbc +1:abc:axc +1:abc:abx +0:abc:xabcy +0:abc:ababc +0:ab*c:abc +0:ab*bc:abc +0:ab*bc:abbc +0:ab*bc:abbbbc +0:ab+bc:abbc +1:ab+bc:abc +1:ab+bc:abq +0:ab+bc:abbbbc +0:ab?bc:abbc +0:ab?bc:abc +1:ab?bc:abbbbc +0:ab?c:abc +0:^abc$:abc +1:^abc$:abcc +0:^abc:abcc +1:^abc$:aabc +0:abc$:aabc +0:^:abc +0:$:abc +0:a.c:abc +0:a.c:axc +0:a.*c:axyzc +1:a.*c:axyzd +1:a[bc]d:abc +0:a[bc]d:abd +1:a[b-d]e:abd +0:a[b-d]e:ace +0:a[b-d]:aac +0:a[-b]:a- +0:a[b-]:a- +2:a[b-a]:- +2:a[]b:- +2:a[:- +0:a]:a] +0:a[]]b:a]b +0:a[^bc]d:aed +1:a[^bc]d:abd +0:a[^-b]c:adc +1:a[^-b]c:a-c +1:a[^]b]c:a]c +0:a[^]b]c:adc +0:ab|cd:abc +0:ab|cd:abcd +0:()ef:def +0:()*:- +2:*a:- +2:^*:- +2:$*:- +2:(*)b:- +1:$b:b +2:a\:- +0:a\(b:a(b +0:a\(*b:ab +0:a\(*b:a((b +1:a\x:a\x +1:abc):- +2:(abc:- +0:((a)):abc +0:(a)b(c):abc +0:a+b+c:aabbabc +0:a**:- +0:a*?:- +0:(a*)*:- +0:(a*)+:- +0:(a|)*:- +0:(a*|b)*:- +0:(a+|b)*:ab +0:(a+|b)+:ab +0:(a+|b)?:ab +0:[^ab]*:cde +0:(^)*:- +0:(ab|)*:- +2:)(:- +1:abc: +1:abc: +0:a*: +0:([abc])*d:abbbcd +0:([abc])*bcd:abcd +0:a|b|c|d|e:e +0:(a|b|c|d|e)f:ef +0:((a*|b))*:- +0:abcd*efg:abcdefg +0:ab*:xabyabbbz +0:ab*:xayabbbz +0:(ab|cd)e:abcde +0:[abhgefdc]ij:hij +1:^(ab|cd)e:abcde +0:(abc|)ef:abcdef +0:(a|b)c*d:abcd +0:(ab|ab*)bc:abc +0:a([bc]*)c*:abc +0:a([bc]*)(c*d):abcd +0:a([bc]+)(c*d):abcd +0:a([bc]*)(c+d):abcd +0:a[bcd]*dcdcde:adcdcde +1:a[bcd]+dcdcde:adcdcde +0:(ab|a)b*c:abc +0:((a)(b)c)(d):abcd +0:[A-Za-z_][A-Za-z0-9_]*:alpha +0:^a(bc+|b[eh])g|.h$:abh +0:(bc+d$|ef*g.|h?i(j|k)):effgz +0:(bc+d$|ef*g.|h?i(j|k)):ij +1:(bc+d$|ef*g.|h?i(j|k)):effg +1:(bc+d$|ef*g.|h?i(j|k)):bcdd +0:(bc+d$|ef*g.|h?i(j|k)):reffgz +1:((((((((((a)))))))))):- +0:(((((((((a))))))))):a +1:multiple words of text:uh-uh +0:multiple words:multiple words, yeah +0:(.*)c(.*):abcde +1:\((.*),:(.*)\) +1:[k]:ab +0:abcd:abcd +0:a(bc)d:abcd +0:a[-]?c:ac +0:(....).*\1:beriberi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Qaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mo'ammar Gadhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Kaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Qadhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Moammar El Kadhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Gadafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mu'ammar al-Qadafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Moamer El Kazzafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Moamar al-Gaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mu'ammar Al Qathafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Al Qathafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mo'ammar el-Gadhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Moamar El Kadhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar al-Qadhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mu'ammar al-Qadhdhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mu'ammar Qadafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Moamar Gaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mu'ammar Qadhdhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Khaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar al-Khaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mu'amar al-Kadafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Ghaddafy +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Ghadafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Ghaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muamar Kaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Quathafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muammar Gheddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Muamar Al-Kaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Moammar Khadafy +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Moammar Qudhafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mu'ammar al-Qaddafi +0:M[ou]'?am+[ae]r .*([AEae]l[- ])?[GKQ]h?[aeu]+([dtz][dhz]?)+af[iy]:Mulazim Awwal Mu'ammar Muhammad Abu Minyar al-Qadhafi +0:[[:digit:]]+:01234 +1:[[:alpha:]]+:01234 +0:^[[:digit:]]*$:01234 +1:^[[:digit:]]*$:01234a +0:^[[:alnum:]]*$:01234a +0:^[[:xdigit:]]*$:01234a +1:^[[:xdigit:]]*$:01234g +0:^[[:alnum:][:space:]]*$:Hello world diff --git a/test/src/regex-tests.el b/test/src/regex-tests.el new file mode 100644 index 00000000000..c4844c7cdbc --- /dev/null +++ b/test/src/regex-tests.el @@ -0,0 +1,680 @@ +;;; regex-tests.el --- tests for regex.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) + +(defvar regex-tests--resources-dir + (concat (concat (file-name-directory (or load-file-name buffer-file-name)) + "/regex-resources/")) + "Path to regex-resources directory next to the \"regex-tests.el\" file.") + +(ert-deftest regex-word-cc-fallback-test () + "Test that ‘[[:cc:]]*x’ matches ‘x’ (bug#24020). + +Test that a regex of the form \"[[:cc:]]*x\" where CC is +a character class which matches a multibyte character X, matches +string \"x\". + +For example, ‘[[:word:]]*\u2620’ regex (note: \u2620 is a word +character) must match a string \"\u2420\"." + (dolist (class '("[[:word:]]" "\\sw")) + (dolist (repeat '("*" "+")) + (dolist (suffix '("" "b" "bar" "\u2620")) + (dolist (string '("" "foo")) + (when (not (and (string-equal repeat "+") + (string-equal string ""))) + (should (string-match (concat "^" class repeat suffix "$") + (concat string suffix))))))))) + +(defun regex--test-cc (name matching not-matching) + (let (case-fold-search) + (should (string-match-p (concat "^[[:" name ":]]*$") matching)) + (should (string-match-p (concat "^[[:" name ":]]*?\u2622$") + (concat matching "\u2622"))) + (should (string-match-p (concat "^[^[:" name ":]]*$") not-matching)) + (should (string-match-p (concat "^[^[:" name ":]]*\u2622$") + (concat not-matching "\u2622"))) + (with-temp-buffer + (insert matching) + (let ((p (point))) + (insert not-matching) + (goto-char (point-min)) + (skip-chars-forward (concat "[:" name ":]")) + (should (equal (point) p)) + (skip-chars-forward (concat "^[:" name ":]")) + (should (equal (point) (point-max))) + (goto-char (point-min)) + (skip-chars-forward (concat "[:" name ":]\u2622")) + (should (or (equal (point) p) (equal (point) (1+ p)))))))) + +(dolist (test '(("alnum" "abcABC012łąka" "-, \t\n") + ("alpha" "abcABCłąka" "-,012 \t\n") + ("digit" "012" "abcABCłąka-, \t\n") + ("xdigit" "0123aBc" "łąk-, \t\n") + ("upper" "ABCŁĄKA" "abc012-, \t\n") + ("lower" "abcłąka" "ABC012-, \t\n") + + ("word" "abcABC012\u2620" "-, \t\n") + + ("punct" ".,-" "abcABC012\u2620 \t\n") + ("cntrl" "\1\2\t\n" ".,-abcABC012\u2620 ") + ("graph" "abcłąka\u2620-," " \t\n\1") + ("print" "abcłąka\u2620-, " "\t\n\1") + + ("space" " \t\n\u2001" "abcABCł0123") + ("blank" " \t" "\n\u2001") + + ("ascii" "abcABC012 \t\n\1" "łą\u2620") + ("nonascii" "łą\u2622" "abcABC012 \t\n\1") + ("unibyte" "abcABC012 \t\n\1" "łą\u2622") + ("multibyte" "łą\u2622" "abcABC012 \t\n\1"))) + (let ((name (intern (concat "regex-tests-" (car test) "-character-class"))) + (doc (concat "Perform sanity test of regexes using " (car test) + " character class. + +Go over all the supported character classes and test whether the +classes and their inversions match what they are supposed to +match. The test is done using `string-match-p' as well as +`skip-chars-forward'."))) + (eval `(ert-deftest ,name () ,doc ,(cons 'regex--test-cc test)) t))) + + +(defmacro regex-tests-generic-line (comment-char test-file whitelist &rest body) + "Reads a line of the test file TEST-FILE, skipping +comments (defined by COMMENT-CHAR), and evaluates the tests in +this line as defined in the BODY. Line numbers in the WHITELIST +are known failures, and are skipped." + + `(with-temp-buffer + (modify-syntax-entry ?_ "w;; ") ; tests expect _ to be a word + (insert-file-contents (concat regex-tests--resources-dir ,test-file)) + (let ((case-fold-search nil) + (line-number 1) + (whitelist-idx 0)) + + (goto-char (point-min)) + + (while (not (eobp)) + (let ((start (point))) + (end-of-line) + (narrow-to-region start (point)) + + (goto-char (point-min)) + + (when + (and + ;; ignore comments + (save-excursion + (re-search-forward ,(concat "^[^" (string comment-char) "]") nil t)) + + ;; skip lines in the whitelist + (let ((whitelist-next + (condition-case nil + (aref ,whitelist whitelist-idx) (args-out-of-range nil)))) + (cond + ;; whitelist exhausted. do process this line + ((null whitelist-next) t) + + ;; we're not yet at the next whitelist element. do + ;; process this line + ((< line-number whitelist-next) t) + + ;; we're past the next whitelist element. This + ;; shouldn't happen + ((> line-number whitelist-next) + (error + (format + "We somehow skipped the next whitelist element: line %d" whitelist-next))) + + ;; we're at the next whitelist element. Skip this + ;; line, and advance the whitelist index + (t + (setq whitelist-idx (1+ whitelist-idx)) nil)))) + ,@body) + + (widen) + (forward-line) + (beginning-of-line) + (setq line-number (1+ line-number))))))) + +(defun regex-tests-compare (string what-failed bounds-ref &optional substring-ref) + "I just ran a search, looking at STRING. WHAT-FAILED describes +what failed, if anything; valid values are 'search-failed, +'compilation-failed and nil. I compare the beginning/end of each +group with their expected values. This is done with either +BOUNDS-REF or SUBSTRING-REF; one of those should be non-nil. +BOUNDS-REF is a sequence \[start-ref0 end-ref0 start-ref1 +end-ref1 ....] while SUBSTRING-REF is the expected substring +obtained by indexing the input string by start/end-ref. + +If the search was supposed to fail then start-ref0/substring-ref0 +is 'search-failed. If the search wasn't even supposed to compile +successfully, then start-ref0/substring-ref0 is +'compilation-failed. If I only care about a match succeeding, +this can be set to t. + +This function returns a string that describes the failure, or nil +on success" + + (when (or + (and bounds-ref substring-ref) + (not (or bounds-ref substring-ref))) + (error "Exactly one of bounds-ref and bounds-ref should be non-nil")) + + (let ((what-failed-ref (car (or bounds-ref substring-ref)))) + + (cond + ((eq what-failed 'search-failed) + (cond + ((eq what-failed-ref 'search-failed) + nil) + ((eq what-failed-ref 'compilation-failed) + "Expected pattern failure; but no match") + (t + "Expected match; but no match"))) + + ((eq what-failed 'compilation-failed) + (cond + ((eq what-failed-ref 'search-failed) + "Expected no match; but pattern failure") + ((eq what-failed-ref 'compilation-failed) + nil) + (t + "Expected match; but pattern failure"))) + + ;; The regex match succeeded + ((eq what-failed-ref 'search-failed) + "Expected no match; but match") + ((eq what-failed-ref 'compilation-failed) + "Expected pattern failure; but match") + + ;; The regex match succeeded, as expected. I now check all the + ;; bounds + (t + (let ((idx 0) + msg + ref next-ref-function compare-ref-function mismatched-ref-function) + + (if bounds-ref + (setq ref bounds-ref + next-ref-function (lambda (x) (cddr x)) + compare-ref-function (lambda (ref start-pos end-pos) + (or (eq (car ref) t) + (and (eq start-pos (car ref)) + (eq end-pos (cadr ref))))) + mismatched-ref-function (lambda (ref start-pos end-pos) + (format + "beginning/end positions: %d/%s and %d/%s" + start-pos (car ref) end-pos (cadr ref)))) + (setq ref substring-ref + next-ref-function (lambda (x) (cdr x)) + compare-ref-function (lambda (ref start-pos end-pos) + (or (eq (car ref) t) + (string= (substring string start-pos end-pos) (car ref)))) + mismatched-ref-function (lambda (ref start-pos end-pos) + (format + "beginning/end positions: %d/%s and %d/%s" + start-pos (car ref) end-pos (cadr ref))))) + + (while (not (or (null ref) msg)) + + (let ((start (match-beginning idx)) + (end (match-end idx))) + + (when (not (funcall compare-ref-function ref start end)) + (setq msg + (format + "Have expected match, but mismatch in group %d: %s" idx (funcall mismatched-ref-function ref start end)))) + + (setq ref (funcall next-ref-function ref) + idx (1+ idx)))) + + (or msg + nil)))))) + + + +(defun regex-tests-match (pattern string bounds-ref &optional substring-ref) + "I match the given STRING against PATTERN. I compare the +beginning/end of each group with their expected values. +BOUNDS-REF is a sequence [start-ref0 end-ref0 start-ref1 end-ref1 +....]. + +If the search was supposed to fail then start-ref0 is +'search-failed. If the search wasn't even supposed to compile +successfully, then start-ref0 is 'compilation-failed. + +This function returns a string that describes the failure, or nil +on success" + + (if (string-match "\\[\\([\\.=]\\)..?\\1\\]" pattern) + ;; Skipping test: [.x.] and [=x=] forms not supported by emacs + nil + + (regex-tests-compare + string + (condition-case nil + (if (string-match pattern string) nil 'search-failed) + ('invalid-regexp 'compilation-failed)) + bounds-ref substring-ref))) + + +(defconst regex-tests-re-even-escapes + "\\(?:^\\|[^\\\\]\\)\\(?:\\\\\\\\\\)*" + "Regex that matches an even number of \\ characters") + +(defconst regex-tests-re-odd-escapes + (concat regex-tests-re-even-escapes "\\\\") + "Regex that matches an odd number of \\ characters") + + +(defun regex-tests-unextend (pattern) + "Basic conversion from extended regexes to emacs ones. This is +mostly a hack that adds \\ to () and | and {}, and removes it if +it already exists. We also change \\S (and \\s) to \\S- (and +\\s-) because extended regexes see the former as whitespace, but +emacs requires an extra symbol character" + + (with-temp-buffer + (insert pattern) + (goto-char (point-min)) + + (while (re-search-forward "[()|{}]" nil t) + ;; point is past special character. If it is escaped, unescape + ;; it + + (if (save-excursion + (re-search-backward (concat regex-tests-re-odd-escapes ".\\=") nil t)) + + ;; This special character is preceded by an odd number of \, + ;; so I unescape it by removing the last one + (progn + (forward-char -2) + (delete-char 1) + (forward-char 1)) + + ;; This special character is preceded by an even (possibly 0) + ;; number of \. I add an escape + (forward-char -1) + (insert "\\") + (forward-char 1))) + + ;; convert \s to \s- + (goto-char (point-min)) + (while (re-search-forward (concat regex-tests-re-odd-escapes "[Ss]") nil t) + (insert "-")) + + (buffer-string))) + +(defun regex-tests-BOOST-frob-escapes (s ispattern) + "Mangle \\ the way it is done in frob_escapes() in +regex-tests-BOOST.c in glibc: \\t, \\n, \\r are interpreted; +\\\\, \\^, \{, \\|, \} are unescaped for the string (not +pattern)" + + ;; this is all similar to (regex-tests-unextend) + (with-temp-buffer + (insert s) + + (let ((interpret-list (list "t" "n" "r"))) + (while interpret-list + (goto-char (point-min)) + (while (re-search-forward + (concat "\\(" regex-tests-re-even-escapes "\\)" + "\\\\" (car interpret-list)) + nil t) + (replace-match (concat "\\1" (car (read-from-string + (concat "\"\\" (car interpret-list) "\"")))))) + + (setq interpret-list (cdr interpret-list)))) + + (when (not ispattern) + ;; unescape \\, \^, \{, \|, \} + (let ((unescape-list (list "\\\\" "^" "{" "|" "}"))) + (while unescape-list + (goto-char (point-min)) + (while (re-search-forward + (concat "\\(" regex-tests-re-even-escapes "\\)" + "\\\\" (car unescape-list)) + nil t) + (replace-match (concat "\\1" (car unescape-list)))) + + (setq unescape-list (cdr unescape-list)))) + ) + (buffer-string))) + + + + +(defconst regex-tests-BOOST-whitelist + [ + ;; emacs is more stringent with regexes involving unbalanced ) + 63 65 69 + + ;; in emacs, regex . doesn't match \n + 91 + + ;; emacs is more forgiving with * and ? that don't apply to + ;; characters + 107 108 109 122 123 124 140 141 142 + + ;; emacs accepts regexes with {} + 161 + + ;; emacs doesn't fail on bogus ranges such as [3-1] or [1-3-5] + 222 223 + + ;; emacs doesn't match (ab*)[ab]*\1 greedily: only 4 chars of + ;; ababaaa match + 284 294 + + ;; ambiguous groupings are ambiguous + 443 444 445 446 448 449 450 + + ;; emacs doesn't know how to handle weird ranges such as [a-Z] and + ;; [[:alpha:]-a] + 539 580 581 + + ;; emacs matches non-greedy regex ab.*? non-greedily + 639 677 712 + ] + "Line numbers in the boost test that should be skipped. These +are false-positive test failures that represent known/benign +differences in behavior.") + +;; - Format +;; - Comments are lines starting with ; +;; - Lines starting with - set options passed to regcomp() and regexec(): +;; - if no "REG_BASIC" is found, with have an extended regex +;; - These set a flag: +;; - REG_ICASE +;; - REG_NEWLINE (ignored by this function) +;; - REG_NOTBOL +;; - REG_NOTEOL +;; +;; - Test lines are +;; pattern string start0 end0 start1 end1 ... +;; +;; - pattern, string can have escapes +;; - string can have whitespace if enclosed in "" +;; - if string is "!", then the pattern is supposed to fail compilation +;; - start/end are of group0, group1, etc. group 0 is the full match +;; - start<0 indicates "no match" +;; - start is the 0-based index of the first character +;; - end is the 0-based index of the first character past the group +(defun regex-tests-BOOST () + (let (failures + basic icase notbol noteol) + (regex-tests-generic-line + ?; "BOOST.tests" regex-tests-BOOST-whitelist + (if (save-excursion (re-search-forward "^-" nil t)) + (setq basic (save-excursion (re-search-forward "REG_BASIC" nil t)) + icase (save-excursion (re-search-forward "REG_ICASE" nil t)) + notbol (save-excursion (re-search-forward "REG_NOTBOL" nil t)) + noteol (save-excursion (re-search-forward "REG_NOTEOL" nil t))) + + (save-excursion + (or (re-search-forward "\\(\\S-+\\)\\s-+\"\\(.*\\)\"\\s-+?\\(.+\\)" nil t) + (re-search-forward "\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-+?\\(.+\\)" nil t) + (re-search-forward "\\(\\S-+\\)\\s-+\\(!\\)" nil t))) + + (let* ((pattern-raw (match-string 1)) + (string-raw (match-string 2)) + (positions-raw (match-string 3)) + (pattern (regex-tests-BOOST-frob-escapes pattern-raw t)) + (string (regex-tests-BOOST-frob-escapes string-raw nil)) + (positions + (if (string= string "!") + (list 'compilation-failed 0) + (mapcar + (lambda (x) + (let ((x (string-to-number x))) + (if (< x 0) nil x))) + (split-string positions-raw))))) + + (when (null (car positions)) + (setcar positions 'search-failed)) + + (when (not basic) + (setq pattern (regex-tests-unextend pattern))) + + ;; great. I now have all the data parsed. Let's use it to do + ;; stuff + (let* ((case-fold-search icase) + (msg (regex-tests-match pattern string positions))) + + (if (and + ;; Skipping test: notbol/noteol not supported + (not notbol) (not noteol) + + msg) + + ;; store failure + (setq failures + (cons (format "line number %d: Regex '%s': %s" + line-number pattern msg) + failures))))))) + + failures)) + +(defconst regex-tests-PCRE-whitelist + [ + ;; ambiguous groupings are ambiguous + 610 611 1154 1157 1160 1168 1171 1176 1179 1182 1185 1188 1193 1196 1203 + ] + "Line numbers in the PCRE test that should be skipped. These +are false-positive test failures that represent known/benign +differences in behavior.") + +;; - Format +;; +;; regex +;; input_string +;; group_num: group_match | "No match" +;; input_string +;; group_num: group_match | "No match" +;; input_string +;; group_num: group_match | "No match" +;; input_string +;; group_num: group_match | "No match" +;; ... +(defun regex-tests-PCRE () + (let (failures + pattern icase string what-failed matches-observed) + (regex-tests-generic-line + ?# "PCRE.tests" regex-tests-PCRE-whitelist + + (cond + + ;; pattern + ((save-excursion (re-search-forward "^/\\(.*\\)/\\(.*i?\\)$" nil t)) + (setq icase (string= "i" (match-string 2)) + pattern (regex-tests-unextend (match-string 1)))) + + ;; string. read it in, match against pattern, and save all the results + ((save-excursion (re-search-forward "^ \\(.*\\)" nil t)) + (let ((case-fold-search icase)) + (setq string (match-string 1) + + ;; the regex match under test + what-failed + (condition-case nil + (if (string-match pattern string) nil 'search-failed) + ('invalid-regexp 'compilation-failed)) + + matches-observed + (cl-loop for x from 0 to 20 + collect (and (not what-failed) + (or (match-string x string) "<unset>"))))) + nil) + + ;; verification line: failed match + ((save-excursion (re-search-forward "^No match" nil t)) + (unless what-failed + (setq failures + (cons (format "line number %d: Regex '%s': Expected no match; but match" + line-number pattern) + failures)))) + + ;; verification line: succeeded match + ((save-excursion (re-search-forward "^ *\\([0-9]+\\): \\(.*\\)" nil t)) + (let* ((match-ref (match-string 2)) + (idx (string-to-number (match-string 1)))) + + (if what-failed + "Expected match; but no match" + (unless (string= match-ref (elt matches-observed idx)) + (setq failures + (cons (format "line number %d: Regex '%s': Have expected match, but group %d is wrong: '%s'/'%s'" + line-number pattern + idx match-ref (elt matches-observed idx)) + failures)))))) + + ;; reset + (t (setq pattern nil) nil))) + + failures)) + +(defconst regex-tests-PTESTS-whitelist + [ + ;; emacs doesn't barf on weird ranges such as [b-a], but simply + ;; fails to match + 138 + + ;; emacs doesn't see DEL (0x78) as a [:cntrl:] character + 168 + ] + "Line numbers in the PTESTS test that should be skipped. These +are false-positive test failures that represent known/benign +differences in behavior.") + +;; - Format +;; - fields separated by ¦ (note: this is not a |) +;; - start¦end¦pattern¦string +;; - start is the 1-based index of the first character +;; - end is the 1-based index of the last character +(defun regex-tests-PTESTS () + (let (failures) + (regex-tests-generic-line + ?# "PTESTS" regex-tests-PTESTS-whitelist + (let* ((fields (split-string (buffer-string) "¦")) + + ;; string has 1-based index of first char in the + ;; match. -1 means "no match". -2 means "invalid + ;; regex". + ;; + ;; start-ref is 0-based index of first char in the + ;; match + ;; + ;; string==0 is a special case, and I have to treat + ;; it as start-ref = 0 + (start-ref (let ((raw (string-to-number (elt fields 0)))) + (cond + ((= raw -2) 'compilation-failed) + ((= raw -1) 'search-failed) + ((= raw 0) 0) + (t (1- raw))))) + + ;; string has 1-based index of last char in the + ;; match. end-ref is 0-based index of first char past + ;; the match + (end-ref (string-to-number (elt fields 1))) + (pattern (elt fields 2)) + (string (elt fields 3))) + + (let ((msg (regex-tests-match pattern string (list start-ref end-ref)))) + (when msg + (setq failures + (cons (format "line number %d: Regex '%s': %s" + line-number pattern msg) + failures)))))) + failures)) + +(defconst regex-tests-TESTS-whitelist + [ + ;; emacs doesn't barf on weird ranges such as [b-a], but simply + ;; fails to match + 42 + + ;; emacs is more forgiving with * and ? that don't apply to + ;; characters + 57 58 59 60 + + ;; emacs is more stringent with regexes involving unbalanced ) + 67 + ] + "Line numbers in the TESTS test that should be skipped. These +are false-positive test failures that represent known/benign +differences in behavior.") + +;; - Format +;; - fields separated by :. Watch for [\[:xxx:]] +;; - expected:pattern:string +;; +;; expected: +;; | 0 | successful match | +;; | 1 | failed match | +;; | 2 | regcomp() should fail | +(defun regex-tests-TESTS () + (let (failures) + (regex-tests-generic-line + ?# "TESTS" regex-tests-TESTS-whitelist + (if (save-excursion (re-search-forward "^\\([^:]+\\):\\(.*\\):\\([^:]*\\)$" nil t)) + (let* ((what-failed + (let ((raw (string-to-number (match-string 1)))) + (cond + ((= raw 2) 'compilation-failed) + ((= raw 1) 'search-failed) + (t t)))) + (string (match-string 3)) + (pattern (regex-tests-unextend (match-string 2)))) + + (let ((msg (regex-tests-match pattern string nil (list what-failed)))) + (when msg + (setq failures + (cons (format "line number %d: Regex '%s': %s" + line-number pattern msg) + failures))))) + + (error "Error parsing TESTS file line: '%s'" (buffer-string)))) + failures)) + +(ert-deftest regex-tests-BOOST () + "Tests of the regular expression engine. +This evaluates the BOOST test cases from glibc." + (should-not (regex-tests-BOOST))) + +(ert-deftest regex-tests-PCRE () + "Tests of the regular expression engine. +This evaluates the PCRE test cases from glibc." + (should-not (regex-tests-PCRE))) + +(ert-deftest regex-tests-PTESTS () + "Tests of the regular expression engine. +This evaluates the PTESTS test cases from glibc." + (should-not (regex-tests-PTESTS))) + +(ert-deftest regex-tests-TESTS () + "Tests of the regular expression engine. +This evaluates the TESTS test cases from glibc." + (should-not (regex-tests-TESTS))) + +;;; regex-tests.el ends here diff --git a/test/automated/textprop-tests.el b/test/src/textprop-tests.el index 397ef28c035..ceb48d1b2db 100644 --- a/test/automated/textprop-tests.el +++ b/test/src/textprop-tests.el @@ -67,3 +67,6 @@ ;; (message "%S" (car stack)) (should (and (equal-including-properties (pop stack) string) (null stack))))) + +(provide 'textprop-tests) +;; textprop-tests.el ends here. diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el new file mode 100644 index 00000000000..73da72e8369 --- /dev/null +++ b/test/src/thread-tests.el @@ -0,0 +1,247 @@ +;;; threads.el --- tests for threads. + +;; Copyright (C) 2012-2016 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 <http://www.gnu.org/licenses/>. + +;;; Code: + +(ert-deftest threads-is-one () + "test for existence of a thread" + (should (current-thread))) + +(ert-deftest threads-threadp () + "test of threadp" + (should (threadp (current-thread)))) + +(ert-deftest threads-type () + "test of thread type" + (should (eq (type-of (current-thread)) 'thread))) + +(ert-deftest threads-name () + "test for name of a thread" + (should + (string= "hi bob" (thread-name (make-thread #'ignore "hi bob"))))) + +(ert-deftest threads-alive () + "test for thread liveness" + (should + (thread-alive-p (make-thread #'ignore)))) + +(ert-deftest threads-all-threads () + "simple test for all-threads" + (should (listp (all-threads)))) + +(defvar threads-test-global nil) + +(defun threads-test-thread1 () + (setq threads-test-global 23)) + +(ert-deftest threads-basic () + "basic thread test" + (should + (progn + (setq threads-test-global nil) + (make-thread #'threads-test-thread1) + (while (not threads-test-global) + (thread-yield)) + threads-test-global))) + +(ert-deftest threads-join () + "test of thread-join" + (should + (progn + (setq threads-test-global nil) + (let ((thread (make-thread #'threads-test-thread1))) + (thread-join thread) + (and threads-test-global + (not (thread-alive-p thread))))))) + +(ert-deftest threads-join-self () + "cannot thread-join the current thread" + (should-error (thread-join (current-thread)))) + +(defvar threads-test-binding nil) + +(defun threads-test-thread2 () + (let ((threads-test-binding 23)) + (thread-yield)) + (setq threads-test-global 23)) + +(ert-deftest threads-let-binding () + "simple test of threads and let bindings" + (should + (progn + (setq threads-test-global nil) + (make-thread #'threads-test-thread2) + (while (not threads-test-global) + (thread-yield)) + (and (not threads-test-binding) + threads-test-global)))) + +(ert-deftest threads-mutexp () + "simple test of mutexp" + (should-not (mutexp 'hi))) + +(ert-deftest threads-mutexp-2 () + "another simple test of mutexp" + (should (mutexp (make-mutex)))) + +(ert-deftest threads-mutex-type () + "type-of mutex" + (should (eq (type-of (make-mutex)) 'mutex))) + +(ert-deftest threads-mutex-lock-unlock () + "test mutex-lock and unlock" + (should + (let ((mx (make-mutex))) + (mutex-lock mx) + (mutex-unlock mx) + t))) + +(ert-deftest threads-mutex-recursive () + "test mutex-lock and unlock" + (should + (let ((mx (make-mutex))) + (mutex-lock mx) + (mutex-lock mx) + (mutex-unlock mx) + (mutex-unlock mx) + t))) + +(defvar threads-mutex nil) +(defvar threads-mutex-key nil) + +(defun threads-test-mlock () + (mutex-lock threads-mutex) + (setq threads-mutex-key 23) + (while threads-mutex-key + (thread-yield)) + (mutex-unlock threads-mutex)) + +(ert-deftest threads-mutex-contention () + "test of mutex contention" + (should + (progn + (setq threads-mutex (make-mutex)) + (setq threads-mutex-key nil) + (make-thread #'threads-test-mlock) + ;; Wait for other thread to get the lock. + (while (not threads-mutex-key) + (thread-yield)) + ;; Try now. + (setq threads-mutex-key nil) + (mutex-lock threads-mutex) + (mutex-unlock threads-mutex) + t))) + +(defun threads-test-mlock2 () + (setq threads-mutex-key 23) + (mutex-lock threads-mutex)) + +(ert-deftest threads-mutex-signal () + "test signaling a blocked thread" + (should + (progn + (setq threads-mutex (make-mutex)) + (setq threads-mutex-key nil) + (mutex-lock threads-mutex) + (let ((thr (make-thread #'threads-test-mlock2))) + (while (not threads-mutex-key) + (thread-yield)) + (thread-signal thr 'quit nil) + (thread-join thr)) + t))) + +(defun threads-test-io-switch () + (setq threads-test-global 23)) + +(ert-deftest threads-io-switch () + "test that accept-process-output causes thread switch" + (should + (progn + (setq threads-test-global nil) + (make-thread #'threads-test-io-switch) + (while (not threads-test-global) + (accept-process-output nil 1)) + threads-test-global))) + +(ert-deftest threads-condvarp () + "simple test of condition-variable-p" + (should-not (condition-variable-p 'hi))) + +(ert-deftest threads-condvarp-2 () + "another simple test of condition-variable-p" + (should (condition-variable-p (make-condition-variable (make-mutex))))) + +(ert-deftest threads-condvar-type () + "type-of condvar" + (should (eq (type-of (make-condition-variable (make-mutex))) + 'condition-variable))) + +(ert-deftest threads-condvar-mutex () + "simple test of condition-mutex" + (should + (let ((m (make-mutex))) + (eq m (condition-mutex (make-condition-variable m)))))) + +(ert-deftest threads-condvar-name () + "simple test of condition-name" + (should + (eq nil (condition-name (make-condition-variable (make-mutex)))))) + +(ert-deftest threads-condvar-name-2 () + "another simple test of condition-name" + (should + (string= "hi bob" + (condition-name (make-condition-variable (make-mutex) + "hi bob"))))) +(defun call-error () + "Call `error'." + (error "Error is called")) + +;; This signals an error internally; the error should be caught. +(defun thread-custom () + (defcustom thread-custom-face 'highlight + "Face used for thread customizations." + :type 'face + :group 'widget-faces)) + +(ert-deftest thread-errors () + "Test what happens when a thread signals an error." + (should (threadp (make-thread #'call-error "call-error"))) + (should (threadp (make-thread #'thread-custom "thread-custom")))) + +(ert-deftest thread-sticky-point () + "Test bug #25165 with point movement in cloned buffer." + (with-temp-buffer + (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit.") + (goto-char (point-min)) + (clone-indirect-buffer nil nil) + (forward-char 20) + (sit-for 1) + (should (= (point) 21)))) + +(ert-deftest thread-signal-early () + "Test signaling a thread as soon as it is started by the OS." + (let ((thread + (make-thread #'(lambda () + (while t (thread-yield)))))) + (thread-signal thread 'error nil) + (sit-for 1) + (should-not (thread-alive-p thread)))) + +;;; threads.el ends here diff --git a/test/automated/undo-tests.el b/test/src/undo-tests.el index b1c786993e8..b1c786993e8 100644 --- a/test/automated/undo-tests.el +++ b/test/src/undo-tests.el diff --git a/test/automated/libxml-tests.el b/test/src/xml-tests.el index dc60197b59e..dc60197b59e 100644 --- a/test/automated/libxml-tests.el +++ b/test/src/xml-tests.el |