[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/dbusbind-type-tests 8987263: Fix minor glitches in
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] scratch/dbusbind-type-tests 8987263: Fix minor glitches in D-Bus code. |
Date: |
Wed, 02 Sep 2015 13:54:11 +0000 |
branch: scratch/dbusbind-type-tests
commit 8987263eb638e916b14b68e45d4b037f480f80e1
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Fix minor glitches in D-Bus code.
* src/dbusbind.c (xd_build_message): New arg CALLER.
(Fdbus_message_internal, Fdbus_message_internal_to_lisp): Use it.
(XD_ADD_HEADER): Rename from ADD_HEADER.
(syms_of_dbusbind): Declare Qdbus_message_internal_to_lisp.
* test/automated/dbus-tests.el
(dbus--test-create-message-with-args): Add docstring. Use Emacs
namespace for interface and path.
(dbus-test04-create-message-parameters): Add tests.
---
src/dbusbind.c | 41 +++++++++++++++++++++--------------------
test/automated/dbus-tests.el | 18 ++++++++++++++++--
2 files changed, 37 insertions(+), 22 deletions(-)
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 523a934..079a0b0 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -190,8 +190,8 @@ xd_symbol_to_dbus_type (Lisp_Object object)
: DBUS_TYPE_INVALID);
}
-/* Determine the DBusType of a given Lisp symbol. OBJECT must be one
- of the predefined D-Bus type symbols. */
+/* Determine the Lisp symbol of a given type. If DTYPE isn't a valid
+ DBusType, Qnil is returned. */
static Lisp_Object
xd_dbus_type_to_symbol (int dtype)
{
@@ -236,8 +236,8 @@ xd_dbus_type_to_symbol (int dtype)
#ifdef DBUS_TYPE_UNIX_FD
case DBUS_TYPE_UNIX_FD:
return QCdbus_type_unix_fd;
-
#endif
+
case DBUS_TYPE_ARRAY:
return QCdbus_type_array;
@@ -1153,7 +1153,8 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
}
/* Convert argument type to a Lisp object. The type DTYPE of the
- argument of the D-Bus message must be a valid DBusType. */
+ argument of the D-Bus message must be a valid DBusType, otherwise
+ Qnil is returned. */
static Lisp_Object
xd_arg_type_to_lisp (int dtype, DBusMessageIter *iter)
{
@@ -1505,14 +1506,15 @@ struct xd_message
{
DBusMessage *dmessage;
- /* Lisp objects used by Fdbus_message_internal. */
+ /* Lisp objects used by Fdbus_message_internal[_to_lisp]. */
Lisp_Object bus;
Lisp_Object handler;
+
int timeout;
};
static void
-xd_build_message (struct xd_message *xmessage,
+xd_build_message (Lisp_Object caller, struct xd_message *xmessage,
ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object message_type, bus, service, handler;
@@ -1561,9 +1563,7 @@ xd_build_message (struct xd_message *xmessage,
XD_DBUS_VALIDATE_BUS_ADDRESS (bus);
XD_DBUS_VALIDATE_BUS_NAME (service);
if (nargs < count)
- xsignal2 (Qwrong_number_of_arguments,
- Qdbus_message_internal,
- make_number (nargs));
+ xsignal2 (Qwrong_number_of_arguments, caller, make_number (nargs));
if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
|| (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
@@ -1755,7 +1755,7 @@ usage: (dbus-message-internal &rest REST) */)
xmessage.timeout = -1;
/* Create a D-Bus message. */
- xd_build_message (&xmessage, nargs, args);
+ xd_build_message (Qdbus_message_internal, &xmessage, nargs, args);
/* Retrieve bus address. */
connection = xd_get_connection_address (xmessage.bus);
@@ -1808,7 +1808,7 @@ xd_dbus_message_to_lisp (DBusMessage *dmessage)
result = Fplist_put (result, QCdbus_type_type,
build_string (XD_MESSAGE_TYPE_TO_STRING (mtype)));
-#define ADD_HEADER(name) \
+#define XD_ADD_HEADER(name) \
{ \
const char *name = dbus_message_get_##name (dmessage); \
if (name) \
@@ -1816,14 +1816,14 @@ xd_dbus_message_to_lisp (DBusMessage *dmessage)
build_string (name)); \
}
- ADD_HEADER (path);
- ADD_HEADER (interface);
- ADD_HEADER (member);
- ADD_HEADER (destination);
- ADD_HEADER (sender);
- ADD_HEADER (signature);
+ XD_ADD_HEADER (path);
+ XD_ADD_HEADER (interface);
+ XD_ADD_HEADER (member);
+ XD_ADD_HEADER (destination);
+ XD_ADD_HEADER (sender);
+ XD_ADD_HEADER (signature);
-#undef ADD_HEADER
+#undef XD_ADD_HEADER
/* Collect the parameters. */
args = Qnil;
@@ -1869,7 +1869,7 @@ usage: (dbus-message-internal-to-lisp &rest REST) */)
xmessage.timeout = -1;
/* Create a D-Bus message. */
- xd_build_message (&xmessage, nargs, args);
+ xd_build_message (Qdbus_message_internal_to_lisp, &xmessage, nargs, args);
/* Convert the D-Bus message to a Lisp expression. */
result = xd_dbus_message_to_lisp (xmessage.dmessage);
@@ -2091,10 +2091,11 @@ syms_of_dbusbind (void)
defsubr (&Sdbus__init_bus);
defsubr (&Sdbus_get_unique_name);
- defsubr (&Sdbus_message_internal_to_lisp);
DEFSYM (Qdbus_message_internal, "dbus-message-internal");
defsubr (&Sdbus_message_internal);
+ DEFSYM (Qdbus_message_internal_to_lisp, "dbus-message-internal-to-lisp");
+ defsubr (&Sdbus_message_internal_to_lisp);
/* D-Bus error symbol. */
DEFSYM (Qdbus_error, "dbus-error");
diff --git a/test/automated/dbus-tests.el b/test/automated/dbus-tests.el
index 19f32f5..69afaa3 100644
--- a/test/automated/dbus-tests.el
+++ b/test/automated/dbus-tests.el
@@ -173,13 +173,14 @@ This includes initialization and closing the bus."
(should-not (dbus-ping :session dbus-service-emacs 100)))
(defun dbus--test-create-message-with-args (&rest args)
+ "Create a D-Bus message according to ARGS."
(dbus-ignore-errors
(apply #'dbus-message-internal-to-lisp
dbus-message-type-method-call
:session
;; Passing nil as SERVICE means not to require bus connection.
nil
- dbus-path-dbus dbus-interface-dbus "Hello" #'ignore :timeout 100
+ dbus-path-emacs dbus-interface-emacs "Hello" #'ignore :timeout 100
args)))
(ert-deftest dbus-test04-create-message-parameters ()
@@ -200,11 +201,24 @@ This includes initialization and closing the bus."
:type :int32 1))
(should (equal (plist-get message :args) '((:int32 1))))
(should (equal (plist-get message :signature) "i"))
- ;; Test explicit type specifications for empty array.
+ ;; Test explicit type specifications for empty array with implicit
+ ;; element type.
(setq message (dbus--test-create-message-with-args
'(:array)))
(should (equal (plist-get message :args) '(((:array nil) nil))))
(should (equal (plist-get message :signature) "as"))
+ ;; Test explicit type specifications for empty array with explicit
+ ;; element type.
+ (setq message (dbus--test-create-message-with-args
+ '(:array :signature "u")))
+ (should (equal (plist-get message :args) '(((:array nil) nil))))
+ (should (equal (plist-get message :signature) "au"))
+ ;; Test explicit type specifications with `:type' keyword for empty array.
+ ;; DOES THIS WORK?
+ (setq message (dbus--test-create-message-with-args
+ :type '(:array :uint32)))
+ (should (equal (plist-get message :args) '(((:array nil) nil))))
+ (should (equal (plist-get message :signature) "au"))
;; Test implicit type specifications for non-empty array.
(setq message (dbus--test-create-message-with-args
'(1 2 3)))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] scratch/dbusbind-type-tests 8987263: Fix minor glitches in D-Bus code.,
Michael Albinus <=