summaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorAndrea Corallo <akrl@sdf.org>2020-10-04 19:45:05 +0200
committerAndrea Corallo <akrl@sdf.org>2020-10-04 19:45:05 +0200
commit44ef24342fd8a2ac876212124ebf38673acda35a (patch)
tree793dc4ba4197559b4bc65339d713c0807a7b2ca9 /test
parentafb765ab3cab7b6582d0def543b23603cd076445 (diff)
parentd8665e6d3473403c90a0831e83439a013d0012d3 (diff)
Merge remote-tracking branch 'savannah/master' into HEAD
Diffstat (limited to 'test')
-rw-r--r--test/data/syntax-comments.txt68
-rw-r--r--test/lisp/calc/calc-tests.el116
-rw-r--r--test/lisp/electric-tests.el3
-rw-r--r--test/lisp/emacs-lisp/backtrace-tests.el2
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el2
-rw-r--r--test/lisp/files-tests.el4
-rw-r--r--test/lisp/gnus/gnus-util-tests.el13
-rw-r--r--test/lisp/gnus/mml-sec-tests.el32
-rw-r--r--test/lisp/mail/uudecode-tests.el4
-rw-r--r--test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml49
-rw-r--r--test/lisp/net/dbus-tests.el816
-rw-r--r--test/lisp/obsolete/cl-tests.el3
-rw-r--r--test/lisp/progmodes/python-tests.el4
-rw-r--r--test/lisp/simple-tests.el2
-rw-r--r--test/lisp/vc/vc-bzr-tests.el5
-rw-r--r--test/lisp/wdired-tests.el16
-rw-r--r--test/manual/cedet/tests/testnsp.cpp2
-rw-r--r--test/src/coding-tests.el2
-rw-r--r--test/src/indent-tests.el59
-rw-r--r--test/src/regex-resources/BOOST.tests4
-rw-r--r--test/src/syntax-tests.el349
21 files changed, 1475 insertions, 80 deletions
diff --git a/test/data/syntax-comments.txt b/test/data/syntax-comments.txt
new file mode 100644
index 00000000000..6f595e4d8dc
--- /dev/null
+++ b/test/data/syntax-comments.txt
@@ -0,0 +1,68 @@
+/* This file is a test file for tests of the comment handling in src/syntax.c.
+ This includes the testing of comments which figure in parse-partial-sexp
+ and scan-lists. */
+
+/* Straight C comments */
+1/* comment */1
+2/**/2
+3// comment
+3
+4//
+4
+5/*/5
+6*/6
+7/* \*/7
+8*/8
+9/* \\*/9
+10*/10
+11// \
+12
+11
+13// \\
+14
+13
+15/* /*/15
+
+/* C Comments within lists */
+59}59
+50{ /*70 comment */71 }50
+51{ /**/ }51
+52{ //72 comment
+73}52
+53{ //
+}53
+54{ //74 \
+}54
+55{/* */}55
+56{ /*76 \*/ }56
+57*/77
+58}58
+60{ /*78 \\*/79}60
+
+
+/* Straight Pascal comments (not nested) */
+20}20
+21{ Comment }21
+22{}22
+23{
+}23
+24{
+25{25
+}24
+26{ \}26
+
+
+/* Straight Lisp comments (not nested) */
+30
+30
+31; Comment
+31
+32;;;;;;;;;
+32
+33; \
+33
+
+Local Variables:
+mode: fundamental
+eval: (set-syntax-table (make-syntax-table))
+End:
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index dce82b6f536..0df96a0e2db 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -458,6 +458,122 @@ An existing calc stack is reused, otherwise a new one is created."
(calcFunc-choose '(frac -15 2) 3))
(calc-tests--choose -7.5 3))))
+(ert-deftest calc-business-days ()
+ (cl-flet ((m (s) (math-parse-date s))
+ (b+ (a b) (calcFunc-badd a b))
+ (b- (a b) (calcFunc-bsub a b)))
+ ;; Sanity check.
+ (should (equal (m "2020-09-07") '(date 737675)))
+
+ ;; Test with standard business days (Mon-Fri):
+ (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue
+ (should (equal (b+ (m "2020-09-08") 1) (m "2020-09-09"))) ; Tue->Wed
+ (should (equal (b+ (m "2020-09-09") 1) (m "2020-09-10"))) ; Wed->Thu
+ (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri
+ (should (equal (b+ (m "2020-09-11") 1) (m "2020-09-14"))) ; Fri->Mon
+
+ (should (equal (b+ (m "2020-09-07") 4) (m "2020-09-11"))) ; Mon->Fri
+ (should (equal (b+ (m "2020-09-07") 6) (m "2020-09-15"))) ; Mon->Tue
+
+ (should (equal (b+ (m "2020-09-12") 1) (m "2020-09-14"))) ; Sat->Mon
+ (should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon
+
+ (should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu
+ (should (equal (b- (m "2020-09-10") 1) (m "2020-09-09"))) ; Thu->Wed
+ (should (equal (b- (m "2020-09-09") 1) (m "2020-09-08"))) ; Wed->Tue
+ (should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon
+ (should (equal (b- (m "2020-09-07") 1) (m "2020-09-04"))) ; Mon->Fri
+
+ (should (equal (b- (m "2020-09-11") 4) (m "2020-09-07"))) ; Fri->Mon
+ (should (equal (b- (m "2020-09-15") 6) (m "2020-09-07"))) ; Tue->Mon
+
+ (should (equal (b- (m "2020-09-12") 1) (m "2020-09-11"))) ; Sat->Fri
+ (should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri
+
+ ;; Stepping fractional days
+ (should (equal (b+ (m "2020-09-08 21:00") '(frac 1 2))
+ (m "2020-09-09 09:00")))
+ (should (equal (b+ (m "2020-09-11 21:00") '(frac 1 2))
+ (m "2020-09-14 09:00")))
+ (should (equal (b- (m "2020-09-08 21:00") '(frac 1 2))
+ (m "2020-09-08 09:00")))
+ (should (equal (b- (m "2020-09-14 06:00") '(frac 1 2))
+ (m "2020-09-11 18:00")))
+
+ ;; Test with a couple of extra days off:
+ (let ((var-Holidays (list 'vec
+ '(var sat var-sat) '(var sun var-sun)
+ (m "2020-09-09") (m "2020-09-11"))))
+
+ (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-08"))) ; Mon->Tue
+ (should (equal (b+ (m "2020-09-08") 1) (m "2020-09-10"))) ; Tue->Thu
+ (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-14"))) ; Thu->Mon
+ (should (equal (b+ (m "2020-09-14") 1) (m "2020-09-15"))) ; Mon->Tue
+ (should (equal (b+ (m "2020-09-15") 1) (m "2020-09-16"))) ; Tue->Wed
+
+ (should (equal (b- (m "2020-09-16") 1) (m "2020-09-15"))) ; Wed->Tue
+ (should (equal (b- (m "2020-09-15") 1) (m "2020-09-14"))) ; Tue->Mon
+ (should (equal (b- (m "2020-09-14") 1) (m "2020-09-10"))) ; Mon->Thu
+ (should (equal (b- (m "2020-09-10") 1) (m "2020-09-08"))) ; Thu->Tue
+ (should (equal (b- (m "2020-09-08") 1) (m "2020-09-07"))) ; Tue->Mon
+ )
+
+ ;; Test with odd non-business weekdays (Tue, Wed, Sat):
+ (let ((var-Holidays '(vec (var tue var-tue)
+ (var wed var-wed)
+ (var sat var-sat))))
+ (should (equal (b+ (m "2020-09-07") 1) (m "2020-09-10"))) ; Mon->Thu
+ (should (equal (b+ (m "2020-09-10") 1) (m "2020-09-11"))) ; Thu->Fri
+ (should (equal (b+ (m "2020-09-11") 1) (m "2020-09-13"))) ; Fri->Sun
+ (should (equal (b+ (m "2020-09-13") 1) (m "2020-09-14"))) ; Sun->Mon
+
+ (should (equal (b- (m "2020-09-14") 1) (m "2020-09-13"))) ; Mon->Sun
+ (should (equal (b- (m "2020-09-13") 1) (m "2020-09-11"))) ; Sun->Fri
+ (should (equal (b- (m "2020-09-11") 1) (m "2020-09-10"))) ; Fri->Thu
+ (should (equal (b- (m "2020-09-10") 1) (m "2020-09-07"))) ; Thu->Mon
+ )
+ ))
+
+(ert-deftest calc-unix-date ()
+ (let* ((d-1970-01-01 (math-parse-date "1970-01-01"))
+ (d-2020-09-07 (math-parse-date "2020-09-07"))
+ (d-1991-01-09-0600 (math-parse-date "1991-01-09 06:00")))
+ ;; calcFunc-unixtime (command "t U") converts a date value to Unix time,
+ ;; and a number to a date.
+ (should (equal d-1970-01-01 '(date 719163)))
+ (should (equal (calcFunc-unixtime d-1970-01-01 0) 0))
+ (should (equal (calc-tests--calc-to-number (cadr (calcFunc-unixtime 0 0)))
+ (cadr d-1970-01-01)))
+ (should (equal (calcFunc-unixtime d-2020-09-07 0)
+ (* (- (cadr d-2020-09-07)
+ (cadr d-1970-01-01))
+ 86400)))
+ (should (equal (calcFunc-unixtime d-1991-01-09-0600 0)
+ 663400800))
+ (should (equal (calc-tests--calc-to-number
+ (cadr (calcFunc-unixtime 663400800 0)))
+ 726841.25))
+
+ (let ((calc-date-format '(U)))
+ ;; Test parsing Unix time.
+ (should (equal (calc-tests--calc-to-number
+ (cadr (math-parse-date "0")))
+ 719163))
+ (should (equal (calc-tests--calc-to-number
+ (cadr (math-parse-date "469324800")))
+ (+ 719163 (/ 469324800 86400))))
+ (should (equal (calc-tests--calc-to-number
+ (cadr (math-parse-date "663400800")))
+ 726841.25))
+
+ ;; Test formatting Unix time.
+ (should (equal (math-format-date d-1970-01-01) "0"))
+ (should (equal (math-format-date d-2020-09-07)
+ (number-to-string (* (- (cadr d-2020-09-07)
+ (cadr d-1970-01-01))
+ 86400))))
+ (should (equal (math-format-date d-1991-01-09-0600) "663400800")))))
+
(provide 'calc-tests)
;;; calc-tests.el ends here
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 8b9c1c5fcb5..5f63f6831b3 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -887,7 +887,8 @@ baz\"\""
(should (equal (buffer-string) "int main () {\n \n}"))))
(ert-deftest electric-layout-control-reindentation ()
- "Same as `e-l-int-main-kernel-style', but checking Bug#35254."
+ "Same as `emacs-lisp-int-main-kernel-style', but checking
+Bug#35254."
(ert-with-test-buffer ()
(plainer-c-mode)
(electric-layout-local-mode 1)
diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el
index 12164b46ec3..fbc71e0ec86 100644
--- a/test/lisp/emacs-lisp/backtrace-tests.el
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -41,7 +41,7 @@
(backtrace-mode)
(setq backtrace-frames (backtrace-get-frames))
(let ((this-index))
- ;; Discard all past `backtrace-tests-make-backtrace'.
+ ;; Discard all past `backtrace-tests--make-backtrace'.
(dotimes (index (length backtrace-frames))
(when (eq (backtrace-frame-fun (nth index backtrace-frames))
'backtrace-tests--make-backtrace)
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 04a7b2f5a0f..6db07b1b707 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -210,7 +210,7 @@ All other elements will be nil."
(defvar edebug-tests-thunks nil
"List containing thunks to run after each command in a keyboard macro.")
(defvar edebug-tests-kbd-macro-index nil
- "Index into `edebug-tests-run-unpacked-kbd-macro's current keyboard macro.")
+ "Index into `edebug-tests-run-kbd-macro's current keyboard macro.")
(defun edebug-tests-run-macro (kbdmac &rest thunks)
"Run a keyboard macro and execute a thunk after each command in it.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 2e9c6adc947..3829f505010 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -960,7 +960,7 @@ unquoted file names."
(let ((linkname (expand-file-name "link" nospecial-dir)))
(should-error (make-symbolic-link tmpfile linkname))))))))
-;; See `files-tests--file-name-non-special--subprocess'.
+;; See `files-tests-file-name-non-special--subprocess'.
;; (ert-deftest files-tests-file-name-non-special-process-file ())
(ert-deftest files-tests-file-name-non-special-rename-file ()
@@ -1104,7 +1104,7 @@ unquoted file names."
(files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial)
(should (equal (vc-registered nospecial) (vc-registered tmpfile)))))
-;; See test `files-tests--file-name-non-special--buffers'.
+;; See test `files-tests-file-name-non-special--buffers'.
;; (ert-deftest files-tests-file-name-non-special-verify-visited-file-modtime ())
(ert-deftest files-tests-file-name-non-special-write-region ()
diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el
index ec58032e84e..47f0a9cf761 100644
--- a/test/lisp/gnus/gnus-util-tests.el
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -151,8 +151,10 @@
(should (equal "Zg==" (gnus-base64-repad "Zg")))
(should (equal "Zg==" (gnus-base64-repad "Zg====")))
- (should (equal (gnus-base64-repad " ") ""))
- (should (equal (gnus-base64-repad "Zg== ") "Zg=="))
+ (should-error (gnus-base64-repad " ")
+ :type 'error)
+ (should-error (gnus-base64-repad "Zg== ")
+ :type 'error)
(should-error (gnus-base64-repad "Z?\x00g==")
:type 'error)
;; line-length
@@ -162,9 +164,10 @@
(should-error (gnus-base64-repad "Zm9v\r\nYmFy" t)
:type 'error)
(should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy" t)))
- (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy" nil)))
- (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy\n" nil)))
- (should (equal (gnus-base64-repad "Zm9v\r\n YmFy\r\n" nil) "Zm9vYmFy"))
+ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy")))
+ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy\n")))
+ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\n YmFy\r\n")))
+ (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v \r\n\tYmFy")))
(should-error (gnus-base64-repad "Zm9v\r\nYmFy" nil 3)
:type 'error))
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index 4c745ea6d73..427018520c8 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -67,7 +67,6 @@ instead of gpg-agent."
(condition-case error
(let ((epg-gpg-home-directory
(expand-file-name "test/data/mml-sec" source-directory))
- (mml-secure-allow-signing-with-unknown-recipient t)
(mml-smime-use 'epg)
;; Create debug output in empty epg-debug-buffer.
(epg-debug t)
@@ -762,37 +761,6 @@ Use sign-with-sender and encrypt-to-self."
method "no-exp@example.org" "sub@example.org" 2 nil))
)))))
-(ert-deftest mml-secure-sign-verify-2 ()
- "Sign message without sender; then verify and test for expected result."
- (skip-unless (test-conf))
- (mml-secure-test-key-fixture
- (lambda ()
- (dolist (method (sign-standards) nil)
- (let ((mml-secure-openpgp-sign-with-sender nil)
- (mml-secure-smime-sign-with-sender nil))
- ;; A single signing key for sender sub@example.org is customized
- ;; in the fixture, but not used here.
- ;; By default, gpg uses the first secret key in the keyring, which
- ;; is 02372A42CA6D40FB (OpenPGP) or
- ;; 0E58229B80EE33959FF718FEEF25402B479DC6E2 (S/MIME) here.
- (mml-secure-test-en-decrypt
- method "uid1@example.org" "sub@example.org" 0 nil)
-
- ;; From sub@example.org, sign with specified key:
- (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB"))
- (mml-secure-smime-signers
- '("D06AA118653CC38E9D0CAF56ED7A2135E1582177")))
- (mml-secure-test-en-decrypt
- method "no-exp@example.org" "sub@example.org" 1 nil))
-
- ;; From sub@example.org, sign with different specified key:
- (let ((mml-secure-openpgp-signers '("C3999CF1268DBEA2"))
- (mml-secure-smime-signers
- '("0E58229B80EE33959FF718FEEF25402B479DC6E2")))
- (mml-secure-test-en-decrypt
- method "no-exp@example.org" "sub@example.org" 1 nil))
- )))))
-
(ert-deftest mml-secure-sign-verify-3 ()
"Try to sign message with expired OpenPGP subkey, which raises an error.
With Ma Gnus v0.14 and earlier a signature would be created with a wrong key."
diff --git a/test/lisp/mail/uudecode-tests.el b/test/lisp/mail/uudecode-tests.el
index 61c20075633..4c9650f556c 100644
--- a/test/lisp/mail/uudecode-tests.el
+++ b/test/lisp/mail/uudecode-tests.el
@@ -43,12 +43,12 @@
(uudecode-tests-read-file
(expand-file-name "uuencoded.txt" uudecode-tests-data-dir))
"Uuencoded data for bookmark-tests.el
-Same as `bookmark-tests-decoded-str' but uuencoded.")
+Same as `uudecode-tests-decoded-str' but uuencoded.")
(defvar uudecode-tests-decoded-str
(uudecode-tests-read-file
(expand-file-name "uudecoded.txt" uudecode-tests-data-dir))
"Plain text data for bookmark-tests.el
-Same as `bookmark-tests-encoded-str' but plain text.")
+Same as `uudecode-tests-encoded-str' but plain text.")
(ert-deftest uudecode-tests-decode-region-internal ()
;; Write to buffer
diff --git a/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml
new file mode 100644
index 00000000000..620f10510f2
--- /dev/null
+++ b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml
@@ -0,0 +1,49 @@
+<?xml version="1.0"?>
+<!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN" "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">
+<node>
+ <interface name="org.freedesktop.DBus.Introspectable">
+ <method name="Introspect">
+ <arg name="xml" type="s" direction="out"/>
+ </method>
+ </interface>
+ <interface name="org.freedesktop.DBus.Properties">
+ <method name="Get">
+ <arg name="interface" type="s" direction="in"/>
+ <arg name="name" type="s" direction="in"/>
+ <arg name="value" type="v" direction="out"/>
+ </method>
+ <method name="Set">
+ <arg name="interface" type="s" direction="in"/>
+ <arg name="name" type="s" direction="in"/>
+ <arg name="value" type="v" direction="in"/>
+ </method>
+ <method name="GetAll">
+ <arg name="interface" type="s" direction="in"/>
+ <arg name="properties" type="a{sv}" direction="out"/>
+ </method>
+ <signal name="PropertiesChanged">
+ <arg name="interface" type="s"/>
+ <arg name="changed_properties" type="a{sv}"/>
+ <arg name="invalidated_properties" type="as"/>
+ </signal>
+ </interface>
+ <interface name="org.gnu.Emacs.TestDBus.Interface">
+ <method name="Connect">
+ <arg name="uuid" type="s" direction="in"/>
+ <arg name="mode" type="y" direction="in"/>
+ <arg name="options" type="a{sv}" direction="in"/>
+ <arg name="interface" type="s" direction="out"/>
+ </method>
+ <method name="DeprecatedMethod0">
+ <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+ </method>
+ <method name="DeprecatedMethod1">
+ <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+ </method>
+ <property name="Connected" type="b" access="read"/>
+ <property name="Player" type="o" access="read"/>
+ <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+ </interface>
+ <node name="node0"/>
+ <node name="node1"/>
+</node>
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 74c0dddcf52..7ebef5d2609 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -46,6 +46,13 @@
(defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface"
"Test interface.")
+(defconst dbus--tests-dir
+ (file-truename
+ (expand-file-name "dbus-resources"
+ (file-name-directory (or load-file-name
+ buffer-file-name))))
+ "Directory containing introspection test data file.")
+
(defun dbus--test-availability (bus)
"Test availability of D-Bus BUS."
(should (dbus-list-names bus))
@@ -309,7 +316,7 @@
(dbus-check-arguments :session dbus--test-service :double "string")
:type 'wrong-type-argument)
- ;; `:unix-fd'. UNIX file descriptors are transfered out-of-band.
+ ;; `:unix-fd'. UNIX file descriptors are transferred out-of-band.
;; We do not support this, and so we cannot do much testing here for
;; `:unix-fd' being an argument (which is an index to the file
;; descriptor in the array of file descriptors that accompany the
@@ -359,11 +366,11 @@
(should
(dbus-check-arguments
:session dbus--test-service '(:variant (:array "string"))))
- ;; No or more than one element.
- ;; FIXME.
- ;; (should-error
- ;; (dbus-check-arguments :session dbus--test-service '(:variant))
- ;; :type 'wrong-type-argument)
+ ;; Empty variant.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service '(:variant))
+ :type 'wrong-type-argument)
+ ;; More than one element.
(should-error
(dbus-check-arguments
:session dbus--test-service
@@ -375,20 +382,22 @@
(should
(dbus-check-arguments
:session dbus--test-service
- '(:array (:dict-entry :string "string" :boolean t))))
+ '(:array (:dict-entry :string "string" :boolean nil))))
;; This is an alternative syntax. FIXME: Shall this be supported?
(should
(dbus-check-arguments
:session dbus--test-service
'(:array :dict-entry (:string "string" :boolean t))))
- ;; FIXME: Must be errors.
- ;; (should
- ;; (dbus-check-arguments
- ;; :session dbus--test-service '(:array (:dict-entry))))
- ;; (should
- ;; (dbus-check-arguments
- ;; :session dbus--test-service '(:array (:dict-entry :string "string"))))
- ;; Not two elements.
+ ;; Empty dict-entry.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service '(:array (:dict-entry)))
+ :type 'wrong-type-argument)
+ ;; One element.
+ (should-error
+ (dbus-check-arguments
+ :session dbus--test-service '(:array (:dict-entry :string "string")))
+ :type 'wrong-type-argument)
(should-error
(dbus-check-arguments
:session dbus--test-service
@@ -405,25 +414,27 @@
(dbus-check-arguments
:session dbus--test-service '(:dict-entry :string "string" :boolean t))
:type 'wrong-type-argument)
- ;; FIXME:! This doesn't look right.
- ;; Different dict entry types can be part of an array ???
- (should
- (dbus-check-arguments
- :session dbus--test-service
- '(:array
- (:dict-entry :string "string1" :boolean t)
- (:dict-entry :string "string2" :object-path "/object/path"))))
+ ;; Different dict entry types are not ched. FIXME: Add check.
+ ;; (should-error
+ ;; (dbus-check-arguments
+ ;; :session dbus--test-service
+ ;; '(:array
+ ;; (:dict-entry :string "string1" :boolean t)
+ ;; (:dict-entry :string "string2" :object-path "/object/path")))
+ ;; :type 'wrong-type-argument)
;; `:struct'. There is no restriction what could be an element of a struct.
- ;; Empty struct. FIXME: Is this right?
- ;; (should (dbus-check-arguments :session dbus--test-service '(:struct)))
(should
(dbus-check-arguments
:session dbus--test-service
'(:struct
:string "string"
:object-path "/object/path"
- (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4))))))
+ (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4)))))
+ ;; Empty struct.
+ (should-error
+ (dbus-check-arguments :session dbus--test-service '(:struct))
+ :type 'wrong-type-argument))
(defun dbus--test-register-service (bus)
"Check service registration at BUS."
@@ -625,6 +636,63 @@ This includes initialization and closing the bus."
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
+(defun dbus--test-method-reentry-handler (&rest _args)
+ "Method handler for `dbus-test04-method-reentry'."
+ (dbus-get-all-managed-objects :session dbus--test-service dbus--test-path)
+ 42)
+
+(ert-deftest dbus-test04-method-reentry ()
+ "Check receiving method call while awaiting response.
+Ensure that incoming method calls are handled when call to `dbus-call-method'
+is in progress."
+ :tags '(:expensive-test)
+ ;; Simulate application registration. (Bug#43251)
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((method "Reentry"))
+ (should
+ (equal
+ (dbus-register-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method #'dbus--test-method-reentry-handler)
+ `((:method :session ,dbus--test-interface ,method)
+ (,dbus--test-service ,dbus--test-path
+ dbus--test-method-reentry-handler))))
+
+ (should
+ (=
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method)
+ 42)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test04-call-method-timeout ()
+ "Verify `dbus-call-method' request timeout."
+ :tags '(:expensive-test)
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+ (dbus-register-service :session dbus--test-service)
+
+ (unwind-protect
+ (let ((start (current-time)))
+ ;; Test timeout override for method call.
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus-interface-introspectable "Introspect" :timeout 2500)
+ :type 'dbus-error)
+
+ (should
+ (< 2.4 (float-time (time-since start)) 2.7)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
(defvar dbus--test-signal-received nil
"Received signal value in `dbus--test-signal-handler'.")
@@ -1069,6 +1137,702 @@ This includes initialization and closing the bus."
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
+(defsubst dbus--test-run-property-test (selector name value expected)
+ "Generate a property test: register, set, get, getall sequence.
+This is a helper function for the macro `dbus--test-property'.
+The argument SELECTOR indicates whether the test should expand to
+`dbus-register-property' (if SELECTOR is `register') or
+`dbus-set-property' (if SELECTOR is `set').
+The argument NAME is the property name.
+The argument VALUE is the value to register or set.
+The argument EXPECTED is a transformed VALUE representing the
+form `dbus-get-property' should return."
+ (cond
+ ((eq selector 'register)
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface name
+ :readwrite value)
+ `((:property :session ,dbus--test-interface ,name)
+ (,dbus--test-service ,dbus--test-path)))))
+
+ ((eq selector 'set)
+ (should
+ (equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface name
+ value)
+ expected)))
+
+ (t (signal 'wrong-type-argument "Selector should be 'register or 'set.")))
+
+ (should
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface name)
+ expected))
+
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service dbus--test-path dbus--test-interface)))
+ (should (equal (cdr (assoc name result)) expected)))
+
+ (let ((result
+ (dbus-get-all-managed-objects :session dbus--test-service "/"))
+ result1)
+ (should (setq result1 (cadr (assoc dbus--test-path result))))
+ (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+ (should (equal (cdr (assoc name result1)) expected))))
+
+(defsubst dbus--test-property (name &rest value-list)
+ "Test a D-Bus property named by string argument NAME.
+The argument VALUE-LIST is a sequence of pairs, where each pair
+represents a value form and an expected returned value form. The
+first pair in VALUES is used for `dbus-register-property'.
+Subsequent pairs of the list are tested with `dbus-set-property'."
+ (let ((values (car value-list)))
+ (dbus--test-run-property-test
+ 'register name (car values) (cdr values)))
+ (dolist (values (cdr value-list))
+ (dbus--test-run-property-test
+ 'set name (car values) (cdr values))))
+
+(ert-deftest dbus-test06-property-types ()
+ "Check property access and mutation for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+ (dbus-register-service :session dbus--test-service)
+
+ (unwind-protect
+ (progn
+ (dbus--test-property
+ "ByteArray"
+ '((:array :byte 1 :byte 2 :byte 3) . (1 2 3))
+ '((:array :byte 4 :byte 5 :byte 6) . (4 5 6)))
+
+ (dbus--test-property
+ "StringArray"
+ '((:array "one" "two" :string "three") . ("one" "two" "three"))
+ '((:array :string "four" :string "five" "six") . ("four" "five" "six")))
+
+ (dbus--test-property
+ "ObjectArray"
+ '((:array
+ :object-path "/node00"
+ :object-path "/node01"
+ :object-path "/node0/node02")
+ . ("/node00" "/node01" "/node0/node02"))
+ '((:array
+ :object-path "/node10"
+ :object-path "/node11"
+ :object-path "/node0/node12")
+ . ("/node10" "/node11" "/node0/node12")))
+
+ (dbus--test-property
+ "Dictionary"
+ '((:array
+ :dict-entry (:string "four" (:variant :string "value of four"))
+ :dict-entry ("five" (:variant :object-path "/node0"))
+ :dict-entry ("six" (:variant (:array :byte 4 :byte 5 :byte 6))))
+ . (("four"
+ ("value of four"))
+ ("five"
+ ("/node0"))
+ ("six"
+ ((4 5 6)))))
+ '((:array
+ :dict-entry
+ (:string "key0" (:variant (:array :byte 7 :byte 8 :byte 9)))
+ :dict-entry ("key1" (:variant :string "value"))
+ :dict-entry ("key2" (:variant :object-path "/node0/node1")))
+ . (("key0"
+ ((7 8 9)))
+ ("key1"
+ ("value"))
+ ("key2"
+ ("/node0/node1")))))
+
+ (dbus--test-property ; Syntax emphasizing :dict compound type.
+ "Dictionary"
+ '((:array
+ (:dict-entry :string "seven" (:variant :string "value of seven"))
+ (:dict-entry "eight" (:variant :object-path "/node8"))
+ (:dict-entry "nine" (:variant (:array :byte 9 :byte 27 :byte 81))))
+ . (("seven"
+ ("value of seven"))
+ ("eight"
+ ("/node8"))
+ ("nine"
+ ((9 27 81)))))
+ '((:array
+ (:dict-entry
+ :string "key4" (:variant (:array :byte 7 :byte 49 :byte 125)))
+ (:dict-entry "key5" (:variant :string "obsolete"))
+ (:dict-entry "key6" (:variant :object-path "/node6/node7")))
+ . (("key4"
+ ((7 49 125)))
+ ("key5"
+ ("obsolete"))
+ ("key6"
+ ("/node6/node7")))))
+
+ (dbus--test-property
+ "ByteDictionary"
+ '((:array
+ (:dict-entry :byte 8 (:variant :string "byte-eight"))
+ (:dict-entry :byte 16 (:variant :object-path "/byte/sixteen"))
+ (:dict-entry :byte 48 (:variant (:array :byte 8 :byte 9 :byte 10))))
+ . (( 8 ("byte-eight"))
+ (16 ("/byte/sixteen"))
+ (48 ((8 9 10))))))
+
+ (dbus--test-property
+ "Variant"
+ '((:variant "Variant string") . ("Variant string"))
+ '((:variant :byte 42) . (42))
+ '((:variant :uint32 1000000) . (1000000))
+ '((:variant :object-path "/variant/path") . ("/variant/path"))
+ '((:variant :signature "a{sa{sv}}") . ("a{sa{sv}}"))
+ '((:variant
+ (:struct
+ 42 "string" (:object-path "/structure/path") (:variant "last")))
+ . ((42 "string" ("/structure/path") ("last")))))
+
+ ;; Test that :read prevents writes.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "StringArray" :read '(:array "one" "two" :string "three"))
+ `((:property :session ,dbus--test-interface "StringArray")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should-error ; Cannot set property with :read access.
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "StringArray" '(:array "seven" "eight" :string "nine"))
+ :type 'dbus-error)
+
+ (should ; Property value preserved on error.
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "StringArray")
+ '("one" "two" "three")))
+
+ ;; Test mismatched types in array.
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "MixedArray" :readwrite
+ '(:array
+ :object-path "/node00"
+ :string "/node01"
+ :object-path "/node0/node02"))
+ :type 'wrong-type-argument)
+
+ ;; Test in-range integer values.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue" :readwrite :byte 255)
+ `((:property :session ,dbus--test-interface "ByteValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue")
+ 255))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ShortValue" :readwrite :int16 32767)
+ `((:property :session ,dbus--test-interface "ShortValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ShortValue")
+ 32767))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UShortValue" :readwrite :uint16 65535)
+ `((:property :session ,dbus--test-interface "UShortValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UShortValue")
+ 65535))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "IntValue" :readwrite :int32 2147483647)
+ `((:property :session ,dbus--test-interface "IntValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface "IntValue")
+ 2147483647))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UIntValue" :readwrite :uint32 4294967295)
+ `((:property :session ,dbus--test-interface "UIntValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UIntValue")
+ 4294967295))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "LongValue" :readwrite :int64 9223372036854775807)
+ `((:property :session ,dbus--test-interface "LongValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "LongValue")
+ 9223372036854775807))
+
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ULongValue" :readwrite :uint64 18446744073709551615)
+ `((:property :session ,dbus--test-interface "ULongValue")
+ (,dbus--test-service ,dbus--test-path))))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ULongValue")
+ 18446744073709551615))
+
+ ;; Test integer overflow.
+ (should
+ (=
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue" :byte 520)
+ 8))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue")
+ 8))
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ShortValue" :readwrite :int16 32800)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UShortValue" :readwrite :uint16 65600)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "IntValue" :readwrite :int32 2147483700)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "UIntValue" :readwrite :uint32 4294967300)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "LongValue" :readwrite :int64 9223372036854775900)
+ :type 'args-out-of-range)
+
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ULongValue" :readwrite :uint64 18446744073709551700)
+ :type 'args-out-of-range)
+
+ ;; dbus-set-property may change property type.
+ (should
+ (=
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue" 1024)
+ 1024))
+
+ (should
+ (=
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue")
+ 1024))
+
+ (should ; Another change property type test.
+ (equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue" :boolean t)
+ t))
+
+ (should
+ (eq
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "ByteValue")
+ t))
+
+ ;; Test invalid type specification.
+ (should-error
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path dbus--test-interface
+ "InvalidType" :readwrite :keyword 128)
+ :type 'wrong-type-argument))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(defun dbus--test-introspect ()
+ "Return test introspection string."
+ (when (string-equal dbus--test-path (dbus-event-path-name last-input-event))
+ (with-temp-buffer
+ (insert-file-contents-literally
+ (expand-file-name "org.gnu.Emacs.TestDBus.xml" dbus--tests-dir))
+ (buffer-string))))
+
+(defsubst dbus--test-validate-interface
+ (iface-name expected-properties expected-methods expected-signals
+ expected-annotations)
+ "Validate an interface definition for `dbus-test07-introspection'.
+The argument IFACE-NAME is a string naming the interface to validate.
+The arguments EXPECTED-PROPERTIES, EXPECTED-METHODS, EXPECTED-SIGNALS, and
+EXPECTED-ANNOTATIONS represent the names of the interface's properties,
+methods, signals, and annotations, respectively."
+
+ (let ((interface
+ (dbus-introspect-get-interface
+ :session dbus--test-service dbus--test-path iface-name)))
+ (pcase-let ((`(interface ((name . ,name)) . ,rest) interface))
+ (should
+ (string-equal name iface-name))
+ (should
+ (string-equal name (dbus-introspect-get-attribute interface "name")))
+
+ (let (properties methods signals annotations)
+ (mapc (lambda (x)
+ (let ((name (dbus-introspect-get-attribute x "name")))
+ (cond
+ ((eq 'property (car x)) (push name properties))
+ ((eq 'method (car x)) (push name methods))
+ ((eq 'signal (car x)) (push name signals))
+ ((eq 'annotation (car x)) (push name annotations)))))
+ rest)
+
+ (should
+ (equal
+ (nreverse properties)
+ expected-properties))
+ (should
+ (equal
+ (nreverse methods)
+ expected-methods))
+ (should
+ (equal
+ (nreverse signals)
+ expected-signals))
+ (should
+ (equal
+ (nreverse annotations)
+ expected-annotations))))))
+
+(defsubst dbus--test-validate-annotations (annotations expected-annotations)
+ "Validate a list of D-Bus ANNOTATIONS.
+Ensure each string in EXPECTED-ANNOTATIONS names an element of ANNOTATIONS.
+And ensure each ANNOTATIONS has a value attribute marked \"true\"."
+ (mapc
+ (lambda (annotation)
+ (let ((name (dbus-introspect-get-attribute annotation "name"))
+ (value (dbus-introspect-get-attribute annotation "value")))
+ (should
+ (member name expected-annotations))
+ (should
+ (equal value "true"))))
+ annotations))
+
+(defsubst dbus--test-validate-property
+ (interface property-name _expected-annotations &rest expected-args)
+ "Validate a property definition for `dbus-test07-introspection'.
+
+The argument INTERFACE is a string naming the interface owning PROPERTY-NAME.
+The argument PROPERTY-NAME is a string naming the property to validate.
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names defined for the method or signal.
+The argument EXPECTED-ARGS is a list of expected arguments for the property."
+ (let* ((property
+ (dbus-introspect-get-property
+ :session dbus--test-service dbus--test-path interface property-name))
+ (name (dbus-introspect-get-attribute property "name"))
+ (type (dbus-introspect-get-attribute property "type"))
+ (access (dbus-introspect-get-attribute property "access"))
+ (expected (assoc-string name expected-args)))
+ (should expected)
+
+ (should
+ (string-equal name property-name))
+
+ (should
+ (string-equal
+ (nth 0 expected)
+ name))
+
+ (should
+ (string-equal
+ (nth 1 expected)
+ type))
+
+ (should
+ (string-equal
+ (nth 2 expected)
+ access))))
+
+(defsubst dbus--test-validate-m-or-s (tree expected-annotations expected-args)
+ "Validate a method or signal definition for `dbus-test07-introspection'.
+The argument TREE is an sexp returned from either `dbus-introspect-get-method'
+or `dbus-introspect-get-signal'
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names defined for the method or signal.
+The argument EXPECTED-ARGS is a list of expected arguments for
+the method or signal."
+ (let (args annotations)
+ (mapc (lambda (elem)
+ (cond
+ ((eq 'arg (car elem)) (push elem args))
+ ((eq 'annotation (car elem)) (push elem annotations))))
+ tree)
+ (should
+ (equal
+ (nreverse args)
+ expected-args))
+ (dbus--test-validate-annotations annotations expected-annotations)))
+
+(defsubst dbus--test-validate-signal
+ (interface signal-name expected-annotations &rest expected-args)
+ "Validate a signal definition for `dbus-test07-introspection'.
+
+The argument INTERFACE is a string naming the interface owning SIGNAL-NAME.
+The argument SIGNAL-NAME is a string naming the signal to validate.
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names defined for the signal.
+The argument EXPECTED-ARGS is a list of expected arguments for the signal."
+ (let ((signal
+ (dbus-introspect-get-signal
+ :session dbus--test-service dbus--test-path interface signal-name)))
+ (pcase-let ((`(signal ((name . ,name)) . ,rest) signal))
+ (should
+ (string-equal name signal-name))
+ (should
+ (string-equal name (dbus-introspect-get-attribute signal "name")))
+ (dbus--test-validate-m-or-s rest expected-annotations expected-args))))
+
+(defsubst dbus--test-validate-method
+ (interface method-name expected-annotations &rest expected-args)
+ "Validate a method definition for `dbus-test07-introspection'.
+
+The argument INTERFACE is a string naming the interface owning METHOD-NAME.
+The argument METHOD-NAME is a string naming the method to validate.
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names defined for the method.
+The argument EXPECTED-ARGS is a list of expected arguments for the method."
+ (let ((method
+ (dbus-introspect-get-method
+ :session dbus--test-service dbus--test-path interface method-name)))
+ (pcase-let ((`(method ((name . ,name)) . ,rest) method))
+ (should
+ (string-equal name method-name))
+ (should
+ (string-equal name (dbus-introspect-get-attribute method "name")))
+ (dbus--test-validate-m-or-s rest expected-annotations expected-args))))
+
+(ert-deftest dbus-test07-introspection ()
+ "Register an Introspection interface then query it."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+ (dbus-register-service :session dbus--test-service)
+
+ ;; Prepare introspection response.
+ (dbus-register-method
+ :session dbus--test-service dbus--test-path dbus-interface-introspectable
+ "Introspect" 'dbus--test-introspect)
+ (dbus-register-method
+ :session dbus--test-service (concat dbus--test-path "/node0")
+ dbus-interface-introspectable
+ "Introspect" 'dbus--test-introspect)
+ (dbus-register-method
+ :session dbus--test-service (concat dbus--test-path "/node1")
+ dbus-interface-introspectable
+ "Introspect" 'dbus--test-introspect)
+ (unwind-protect
+ (let ((start (current-time)))
+ ;; dbus-introspect-get-node-names
+ (should
+ (equal
+ (dbus-introspect-get-node-names
+ :session dbus--test-service dbus--test-path)
+ '("node0" "node1")))
+
+ ;; dbus-introspect-get-all-nodes
+ (should
+ (equal
+ (dbus-introspect-get-all-nodes
+ :session dbus--test-service dbus--test-path)
+ (list dbus--test-path
+ (concat dbus--test-path "/node0")
+ (concat dbus--test-path "/node1"))))
+
+ ;; dbus-introspect-get-interface-names
+ (let ((interfaces
+ (dbus-introspect-get-interface-names
+ :session dbus--test-service dbus--test-path)))
+
+ (should
+ (equal
+ interfaces
+ `(,dbus-interface-introspectable
+ ,dbus-interface-properties
+ ,dbus--test-interface)))
+
+ (dbus--test-validate-interface
+ dbus-interface-introspectable nil '("Introspect") nil nil)
+
+ ;; dbus-introspect-get-interface via `dbus--test-validate-interface'.
+ (dbus--test-validate-interface
+ dbus-interface-properties nil
+ '("Get" "Set" "GetAll") '("PropertiesChanged") nil)
+
+ (dbus--test-validate-interface
+ dbus--test-interface '("Connected" "Player")
+ '("Connect" "DeprecatedMethod0" "DeprecatedMethod1") nil
+ `(,dbus-annotation-deprecated)))
+
+ ;; dbus-introspect-get-method-names
+ (let ((methods
+ (dbus-introspect-get-method-names
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (should
+ (equal
+ methods
+ '("Connect" "DeprecatedMethod0" "DeprecatedMethod1")))
+
+ ;; dbus-introspect-get-method via `dbus--test-validate-method'.
+ (dbus--test-validate-method
+ dbus--test-interface "Connect" nil
+ '(arg ((name . "uuid") (type . "s") (direction . "in")))
+ '(arg ((name . "mode") (type . "y") (direction . "in")))
+ '(arg ((name . "options") (type . "a{sv}") (direction . "in")))
+ '(arg ((name . "interface") (type . "s") (direction . "out"))))
+
+ (dbus--test-validate-method
+ dbus--test-interface "DeprecatedMethod0"
+ `(,dbus-annotation-deprecated))
+
+ (dbus--test-validate-method
+ dbus--test-interface "DeprecatedMethod1"
+ `(,dbus-annotation-deprecated)))
+
+ ;; dbus-introspect-get-signal-names
+ (let ((signals
+ (dbus-introspect-get-signal-names
+ :session dbus--test-service dbus--test-path
+ dbus-interface-properties)))
+ (should
+ (equal
+ signals
+ '("PropertiesChanged")))
+
+ ;; dbus-introspect-get-signal via `dbus--test-validate-signal'.
+ (dbus--test-validate-signal
+ dbus-interface-properties "PropertiesChanged" nil
+ '(arg ((name . "interface") (type . "s")))
+ '(arg ((name . "changed_properties") (type . "a{sv}")))
+ '(arg ((name . "invalidated_properties") (type . "as")))))
+
+ ;; dbus-intropct-get-property-names
+ (let ((properties
+ (dbus-introspect-get-property-names
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (should
+ (equal
+ properties
+ '("Connected" "Player")))
+
+ ;; dbus-introspect-get-property via `dbus--test-validate-property'.
+ (dbus--test-validate-property
+ dbus--test-interface "Connected" nil
+ '("Connected" "b" "read")
+ '("Player" "o" "read")))
+
+ ;; Elapsed time over a second suggests timeouts.
+ (should
+ (< 0.0 (float-time (time-since start)) 1.0)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test07-introspection-timeout ()
+ "Verify introspection request timeouts."
+ :tags '(:expensive-test)
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+ (dbus-register-service :session dbus--test-service)
+
+ (unwind-protect
+ (let ((start (current-time)))
+ (dbus-introspect-xml :session dbus--test-service dbus--test-path)
+ ;; Introspection internal timeout is one second.
+ (should
+ (< 1.0 (float-time (time-since start)))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
(defun dbus-test-all (&optional interactive)
"Run all tests for \\[dbus]."
(interactive "p")
diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el
index 37061df0a7a..3f3fda3638e 100644
--- a/test/lisp/obsolete/cl-tests.el
+++ b/test/lisp/obsolete/cl-tests.el
@@ -21,7 +21,8 @@
;;; Code:
-(require 'cl)
+(with-no-warnings
+ (require 'cl))
(require 'ert)
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index 6b3e63653be..bc77443ff4f 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -339,7 +339,7 @@ def func(arg):
# I don't do much
return arg
# This comment is badly indented because the user forced so.
- # At this line python.el wont dedent, user is always right.
+ # At this line python.el won't dedent, user is always right.
comment_wins_over_ender = True
@@ -358,7 +358,7 @@ comment_wins_over_ender = True
;; The return keyword do make indentation lose a level...
(should (= (python-indent-calculate-indentation) 0))
;; ...but the current indentation was forced by the user.
- (python-tests-look-at "# At this line python.el wont dedent")
+ (python-tests-look-at "# At this line python.el won't dedent")
(should (eq (car (python-indent-context)) :after-comment))
(should (= (python-indent-calculate-indentation) 4))
;; Should behave the same for blank lines: potentially a comment.
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 457de91c149..d4b316811e6 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -44,7 +44,7 @@
;;; `count-words'
(ert-deftest simple-test-count-words-bug-41761 ()
(with-temp-buffer
- (dotimes (i 10) (insert (propertize "test " 'field (cons nil nil))))
+ (dotimes (_i 10) (insert (propertize "test " 'field (cons nil nil))))
(should (= (count-words (point-min) (point-max)) 10))))
diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el
index b68a6945129..408d6e8e23d 100644
--- a/test/lisp/vc/vc-bzr-tests.el
+++ b/test/lisp/vc/vc-bzr-tests.el
@@ -131,7 +131,6 @@
(make-directory bzrdir)
(expand-file-name "foo.el" bzrdir)))
(default-directory (file-name-as-directory bzrdir))
- (generated-autoload-file (expand-file-name "loaddefs.el" bzrdir))
(process-environment (cons (format "HOME=%s" homedir)
process-environment)))
(unwind-protect
@@ -148,7 +147,9 @@
;; causes bzr status to fail. This simulates a broken bzr
;; installation.
(delete-file ".bzr/checkout/dirstate")
- (should (progn (update-directory-autoloads default-directory)
+ (should (progn (make-directory-autoloads
+ default-directory
+ (expand-file-name "loaddefs.el" bzrdir))
t)))
(delete-directory homedir t))))
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index b89e8c876e2..f876967bf98 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -178,6 +178,22 @@ wdired-get-filename before and after editing."
(server-force-delete)
(delete-directory test-dir t))))
+(ert-deftest wdired-test-bug39280 ()
+ "Test for https://debbugs.gnu.org/39280."
+ (let* ((test-dir (make-temp-file "test-dir" 'dir))
+ (fname "foo")
+ (full-fname (expand-file-name fname test-dir)))
+ (make-empty-file full-fname)
+ (let ((buf (find-file-noselect test-dir)))
+ (unwind-protect
+ (with-current-buffer buf
+ (dired-toggle-read-only)
+ (dolist (old '(t nil))
+ (should (equal fname (wdired-get-filename 'nodir old)))
+ (should (equal full-fname (wdired-get-filename nil old))))
+ (wdired-finish-edit))
+ (if buf (kill-buffer buf))
+ (delete-directory test-dir t)))))
(provide 'wdired-tests)
;;; wdired-tests.el ends here
diff --git a/test/manual/cedet/tests/testnsp.cpp b/test/manual/cedet/tests/testnsp.cpp
index fce707bf20b..b72a44c8ca8 100644
--- a/test/manual/cedet/tests/testnsp.cpp
+++ b/test/manual/cedet/tests/testnsp.cpp
@@ -93,7 +93,7 @@ void foo(void) {
; // #4# ( "Mumble" "get" )
}
-// What happens if a type your looking for is scoped withing a type,
+// What happens if a type your looking for is scoped within a type,
// but you are one level into the completion so the originating scope
// excludes the type of the variable you are completing through?
// Thanks Martin Stein for this nice example.
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index c438ae22ce3..82883a045c8 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -143,7 +143,7 @@
;; Optional 5th arg TRANSLATOR is a function to translate the original
;; file contents to match with the expected result of decoding. For
;; instance, when a file of dos eol-type is read by unix eol-type,
-;; `decode-test-lf-to-crlf' must be specified.
+;; `coding-tests-lf-to-crlf' must be specified.
(defun coding-tests (content-type write-coding read-coding detected-coding
&optional translator)
diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el
new file mode 100644
index 00000000000..7d1a6ce6dc3
--- /dev/null
+++ b/test/src/indent-tests.el
@@ -0,0 +1,59 @@
+;;; indent-tests.el --- tests for src/indent.c -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 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 `https://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;;; Code:
+
+(ert-deftest indent-tests-move-to-column-invis-1tab ()
+ "Test `move-to-column' when a TAB is followed by invisible text."
+ (should
+ (string=
+ (with-temp-buffer
+ (insert "\tLine starting with INVISIBLE text after TAB\n")
+ (add-text-properties 2 21 '(invisible t))
+ (goto-char (point-min))
+ (move-to-column 7 t)
+ (buffer-substring-no-properties 1 8))
+ " ")))
+
+(ert-deftest indent-tests-move-to-column-invis-2tabs ()
+ "Test `move-to-column' when 2 TABs are followed by invisible text."
+ (should
+ (string=
+ (with-temp-buffer
+ (insert "\t\tLine starting with INVISIBLE text after TAB\n")
+ (add-text-properties 3 22 '(invisible t))
+ (goto-char (point-min))
+ (move-to-column 12 t)
+ (buffer-substring-no-properties 1 11))
+ "\t \tLine")))
+
+(ert-deftest indent-tests-move-to-column-invis-between-tabs ()
+ "Test `move-to-column' when 2 TABs are mixed with invisible text."
+ (should
+ (string=
+ (with-temp-buffer
+ (insert "\txxx\tLine starting with INVISIBLE text after TAB\n")
+ (add-text-properties 6 25 '(invisible t))
+ (add-text-properties 2 5 '(invisible t))
+ (goto-char (point-min))
+ (move-to-column 12 t)
+ (buffer-substring-no-properties 1 14))
+ "\txxx \tLine")))
diff --git a/test/src/regex-resources/BOOST.tests b/test/src/regex-resources/BOOST.tests
index 98fd3b6abf3..756fa00486b 100644
--- a/test/src/regex-resources/BOOST.tests
+++ b/test/src/regex-resources/BOOST.tests
@@ -93,7 +93,7 @@ aa\) !
. \0 0 1
;
-; now move on to the repetion ops,
+; now move on to the repetition ops,
; starting with operator *
- match_default normal REG_EXTENDED
a* b 0 0
@@ -275,7 +275,7 @@ 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.
+; re implementations will match though.
a(([bc])\2)*d abbccd 0 6 3 5 3 4
a(([bc])\2)*d abbcbd -1 -1
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
index 65c56b3b29d..56e03380579 100644
--- a/test/src/syntax-tests.el
+++ b/test/src/syntax-tests.el
@@ -82,4 +82,353 @@ also has open paren syntax (see Bug#24870)."
(should (equal (parse-partial-sexp pointC pointX nil nil ppsC)
ppsX)))))
+
+;;; Commentary:
+;; The next bit tests the handling of comments in syntax.c, in
+;; particular the functions `forward-comment' and `scan-lists' and
+;; `parse-partial-sexp' (in so far as they relate to comments).
+
+;; It is intended to enhance this bit to test nested comments
+;; (2020-10-01).
+
+;; This bit uses the data file test/data/syntax-comments.txt.
+
+(defun syntax-comments-point (n forw)
+ "Return the buffer offset corresponding to the \"label\" N.
+N is a decimal number which appears in the data file, usually
+twice, as \"labels\". It can also be a negative number or zero.
+FORW is t when we're using the label at BOL, nil for the one at EOL.
+
+If the label N doesn't exist in the current buffer, an exception
+is thrown.
+
+When FORW is t and N positive, we return the position after the
+first occurrence of label N at BOL in the data file. With FORW
+nil, we return the position before the last occurrence of the
+label at EOL in the data file.
+
+When N is negative, we return instead the position of the end of
+line that the -N label is on. When it is zero, we return POINT."
+ (if (zerop n)
+ (point)
+ (let ((str (format "%d" (abs n))))
+ (save-excursion
+ (if forw
+ (progn
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^\\(" str "\\)\\([^0-9\n]\\|$\\)"))
+ (if (< n 0)
+ (progn (end-of-line) (point))
+ (match-end 1)))
+ (goto-char (point-max))
+ (re-search-backward
+ (concat "\\(^\\|[^0-9]\\)\\(" str "\\)$"))
+ (if (< n 0)
+ (progn (end-of-line) (point))
+ (match-beginning 2)))))))
+
+(defun syntax-comments-midpoint (n)
+ "Return the buffer offset corresponding to the \"label\" N.
+N is a positive decimal number which should appear in the buffer
+exactly once. The label need not be at the beginning or end of a
+line.
+
+The return value is the position just before the label.
+
+If the label N doesn't exist in the current buffer, an exception
+is thrown."
+ (let ((str (format "%d" n)))
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "\\(^\\|[^0-9]\\)\\(" str "\\)\\([^0-9\n]\\|$\\)"))
+ (match-beginning 2))))
+
+(eval-and-compile
+ (defvar syntax-comments-section))
+
+(defmacro syntax-comments (-type- -dir- res start &optional stop)
+ "Create an ERT test to test (forward-comment 1/-1).
+The test uses a fixed name data file, which it visits. It calls
+entry and exit functions to set up and tear down syntax entries
+for comment characters. The test is given a name based on the
+global variable `syntax-comments-section', the direction of
+movement and the value of START.
+
+-TYPE- (unquoted) is a symbol from whose name the entry and exit
+function names are derived by appending \"-in\" and \"-out\".
+
+-DIR- (unquoted) is `forward' or `backward', the direction
+`forward-comment' is attempted.
+
+RES, t or nil, is the expected result from `forward-comment'.
+
+START and STOP are decimal numbers corresponding to labels in the
+data file marking the start and expected stop positions. See
+`syntax-comments-point' for a precise specification. If STOP is
+missing or nil, the value of START is assumed for it."
+ (declare (debug t))
+ (let ((forw
+ (cond
+ ((eq -dir- 'forward) t)
+ ((eq -dir- 'backward) nil)
+ (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-))))
+ (start-str (format "%d" (abs start)))
+ (type -type-))
+ `(ert-deftest ,(intern (concat "syntax-comments-"
+ syntax-comments-section
+ (if forw "-f" "-b") start-str))
+ ()
+ (with-current-buffer
+ (find-file
+ ,(expand-file-name "data/syntax-comments.txt"
+ (getenv "EMACS_TEST_DIRECTORY")))
+ (,(intern (concat (symbol-name type) "-in")))
+ (goto-char (syntax-comments-point ,start ,forw))
+ (let ((stop (syntax-comments-point ,(or stop start) ,(not forw))))
+ (should (eq (forward-comment ,(if forw 1 -1)) ,res))
+ (should (eq (point) stop)))
+ (,(intern (concat (symbol-name type) "-out")))))))
+
+(defmacro syntax-br-comments (-type- -dir- res -start- &optional stop)
+ "Create an ERT test to test (scan-lists <position> 1/-1 0).
+This is to test the interface between scan-lists and the internal
+comment routines in syntax.c.
+
+The test uses a fixed name data file, which it visits. It calls
+entry and exit functions to set up and tear down syntax entries
+for comment and paren characters. The test is given a name based
+on the global variable `syntax-comments-section', the direction
+of movement and the value of -START-.
+
+-TYPE- (unquoted) is a symbol from whose name the entry and exit
+function names are derived by appending \"-in\" and \"-out\".
+
+-DIR- (unquoted) is `forward' or `backward', the direction
+`scan-lists' is attempted.
+
+RES is t if `scan-lists' is expected to return, nil if it is
+expected to raise a `scan-error' exception.
+
+-START- and STOP are decimal numbers corresponding to labels in the
+data file marking the start and expected stop positions. See
+`syntax-comments-point' for a precise specification. If STOP is
+missing or nil, the value of -START- is assumed for it."
+ (declare (debug t))
+ (let* ((forw
+ (cond
+ ((eq -dir- 'forward) t)
+ ((eq -dir- 'backward) nil)
+ (t (error "Invalid -dir- argument \"%s\" to `syntax-comments'" -dir-))))
+ (start -start-)
+ (start-str (format "%d" (abs start)))
+ (type -type-))
+ `(ert-deftest ,(intern (concat "syntax-br-comments-"
+ syntax-comments-section
+ (if forw "-f" "-b") start-str))
+ ()
+ (with-current-buffer
+ (find-file
+ ,(expand-file-name "data/syntax-comments.txt"
+ (getenv "EMACS_TEST_DIRECTORY")))
+ (,(intern (concat (symbol-name type) "-in")))
+ (let ((start-pos (syntax-comments-point ,start ,forw))
+ ,@(if res
+ `((stop-pos (syntax-comments-point
+ ,(or stop start) ,(not forw))))))
+ ,(if res
+ `(should
+ (eq (scan-lists start-pos ,(if forw 1 -1) 0)
+ stop-pos))
+ `(should-error (scan-lists start-pos ,(if forw 1 -1) 0)
+ :type 'scan-error)))
+ (,(intern (concat (symbol-name type) "-out")))))))
+
+(defmacro syntax-pps-comments (-type- -start- open close &optional -stop-)
+ "Create an ERT test to test `parse-partial-sexp' with comments.
+This is to test the interface between `parse-partial-sexp' and
+the internal comment routines in syntax.c.
+
+The test uses a fixed name data file, which it visits. It calls
+entry and exit functions to set up and tear down syntax entries
+for comment and paren characters. The test is given a name based
+on the global variable `syntax-comments-section', and the value
+of -START-.
+
+The generated test calls `parse-partial-sexp' three times, the
+first two with COMMENTSTOP set to `syntax-table' so as to stop
+after the start and end of the comment. The third call is
+expected to stop at the brace/paren matching the one where the
+test started.
+
+-TYPE- (unquoted) is a symbol from whose name the entry and exit
+function names are derived by appending \"-in\" and \"-out\".
+
+-START- and -STOP- are decimal numbers corresponding to labels in
+the data file marking the start and expected stop positions. See
+`syntax-comments-point' for a precise specification. If -STOP-
+is missing or nil, the value of -START- is assumed for it.
+
+OPEN and CLOSE are decimal numbers corresponding to labels in the
+data file marking just after the comment opener and closer where
+the `parse-partial-sexp's are expected to stop. See
+`syntax-comments-midpoint' for a precise specification."
+ (declare (debug t))
+ (let* ((type -type-)
+ (start -start-)
+ (start-str (format "%d" start))
+ (stop (or -stop- start)))
+ `(ert-deftest ,(intern (concat "syntax-pps-comments-"
+ syntax-comments-section
+ "-" start-str))
+ ()
+ (with-current-buffer
+ (find-file
+ ,(expand-file-name "data/syntax-comments.txt"
+ (getenv "EMACS_TEST_DIRECTORY")))
+ (,(intern (concat (symbol-name type) "-in")))
+ (let ((start-pos (syntax-comments-point ,start t))
+ (open-pos (syntax-comments-midpoint ,open))
+ (close-pos (syntax-comments-midpoint ,close))
+ (stop-pos (syntax-comments-point ,stop nil))
+ s)
+ (setq s (parse-partial-sexp
+ start-pos (point-max) 0 nil nil 'syntax-table))
+ (should (eq (point) open-pos))
+ (setq s (parse-partial-sexp
+ (point) (point-max) 0 nil s 'syntax-table))
+ (should (eq (point) close-pos))
+ (setq s (parse-partial-sexp (point) (point-max) 0 nil s))
+ (should (eq (point) stop-pos)))
+ (,(intern (concat (symbol-name type) "-out")))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; "Pascal" style comments - single character delimiters, the closing
+;; delimiter not being newline.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun {-in ()
+ (setq parse-sexp-ignore-comments t)
+ (setq comment-end-can-be-escaped nil)
+ (modify-syntax-entry ?{ "<")
+ (modify-syntax-entry ?} ">"))
+(defun {-out ()
+ (modify-syntax-entry ?{ "(}")
+ (modify-syntax-entry ?} "){"))
+(eval-and-compile
+ (setq syntax-comments-section "pascal"))
+
+(syntax-comments { forward nil 20 0)
+(syntax-comments { backward nil 20 0)
+(syntax-comments { forward t 21)
+(syntax-comments { backward t 21)
+(syntax-comments { forward t 22)
+(syntax-comments { backward t 22)
+
+(syntax-comments { forward t 23)
+(syntax-comments { backward t 23)
+(syntax-comments { forward t 24)
+(syntax-comments { backward t 24)
+(syntax-comments { forward t 26)
+(syntax-comments { backward t 26)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; "Lisp" style comments - single character opening delimiters on line
+;; comments.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun \;-in ()
+ (setq parse-sexp-ignore-comments t)
+ (setq comment-end-can-be-escaped nil)
+ (modify-syntax-entry ?\n ">")
+ (modify-syntax-entry ?\; "<"))
+(defun \;-out ()
+ (modify-syntax-entry ?\n " ")
+ (modify-syntax-entry ?\; "."))
+(eval-and-compile
+ (setq syntax-comments-section "lisp"))
+
+(syntax-comments \; backward nil 30 30)
+(syntax-comments \; forward t 31)
+(syntax-comments \; backward t 31)
+(syntax-comments \; forward t 32)
+(syntax-comments \; backward t 32)
+(syntax-comments \; forward t 33)
+(syntax-comments \; backward t 33)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Emacs 27 "C" style comments - `comment-end-can-be-escaped' is non-nil.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun /*-in ()
+ (setq parse-sexp-ignore-comments t)
+ (setq comment-end-can-be-escaped t)
+ (modify-syntax-entry ?/ ". 124b")
+ (modify-syntax-entry ?* ". 23")
+ (modify-syntax-entry ?\n "> b"))
+(defun /*-out ()
+ (setq comment-end-can-be-escaped nil)
+ (modify-syntax-entry ?/ ".")
+ (modify-syntax-entry ?* ".")
+ (modify-syntax-entry ?\n " "))
+(eval-and-compile
+ (setq syntax-comments-section "c"))
+
+(syntax-comments /* forward t 1)
+(syntax-comments /* backward t 1)
+(syntax-comments /* forward t 2)
+(syntax-comments /* backward t 2)
+(syntax-comments /* forward t 3)
+(syntax-comments /* backward t 3)
+
+(syntax-comments /* forward t 4)
+(syntax-comments /* backward t 4)
+(syntax-comments /* forward t 5 6)
+(syntax-comments /* backward nil 5 0)
+(syntax-comments /* forward nil 6 0)
+(syntax-comments /* backward t 6 5)
+
+(syntax-comments /* forward t 7 8)
+(syntax-comments /* backward nil 7 0)
+(syntax-comments /* forward nil 8 0)
+(syntax-comments /* backward t 8 7)
+(syntax-comments /* forward t 9)
+(syntax-comments /* backward t 9)
+
+(syntax-comments /* forward nil 10 0)
+(syntax-comments /* backward nil 10 0)
+(syntax-comments /* forward t 11)
+(syntax-comments /* backward t 11)
+
+(syntax-comments /* forward t 13 14)
+(syntax-comments /* backward nil 13 -14)
+(syntax-comments /* forward t 15)
+(syntax-comments /* backward t 15)
+
+;; Emacs 27 "C" style comments inside brace lists.
+(syntax-br-comments /* forward t 50)
+(syntax-br-comments /* backward t 50)
+(syntax-br-comments /* forward t 51)
+(syntax-br-comments /* backward t 51)
+(syntax-br-comments /* forward t 52)
+(syntax-br-comments /* backward t 52)
+
+(syntax-br-comments /* forward t 53)
+(syntax-br-comments /* backward t 53)
+(syntax-br-comments /* forward t 54 20)
+(syntax-br-comments /* backward t 54)
+(syntax-br-comments /* forward t 55)
+(syntax-br-comments /* backward t 55)
+
+(syntax-br-comments /* forward t 56 58)
+(syntax-br-comments /* backward t 58 56)
+(syntax-br-comments /* backward nil 59)
+(syntax-br-comments /* forward t 60)
+(syntax-br-comments /* backward t 60)
+
+;; Emacs 27 "C" style comments parsed by `parse-partial-sexp'.
+(syntax-pps-comments /* 50 70 71)
+(syntax-pps-comments /* 52 72 73)
+(syntax-pps-comments /* 54 74 55 20)
+(syntax-pps-comments /* 56 76 77 58)
+(syntax-pps-comments /* 60 78 79)
+
;;; syntax-tests.el ends here