[libnet-dbus-perl] 254/335: Fix marshalling of variants when using Net::DBus::Binding::Value (Dave Belser)

[Intrigeri]

This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to branch experimental
in repository libnet-dbus-perl.

commit 7d496c69feb05edb2c7a25fa0fec4d1b1199297a
Author: Daniel P. Berrange <berrange at redhat.com>
Date:   Wed Feb 6 19:53:31 2008 -0500

    Fix marshalling of variants when using Net::DBus::Binding::Value (Dave Belser)
---
 AUTHORS                           |  1 +
 lib/Net/DBus/Binding/Iterator.pm  |  7 +++++--
 lib/Net/DBus/Test/MockIterator.pm |  7 +++++--
 t/60-object-props.t               | 28 +++++++++++++++++++++++++++-
 4 files changed, 38 insertions(+), 5 deletions(-)

diff --git a/AUTHORS b/AUTHORS
index 22e55ed..58542b4 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -12,6 +12,7 @@ from
     Emmanuele Bassi <ebassi-at-gmail-dot-com>
     Olivier Blin <oblin-at-mandriva-dot-com>
     Jack <ms419-at-freezone-dot-co-dot-uk>
+    Dave Belser <dbelser-at-aerosat-dot-com>
 
     [...send patches to get your name here!]
 
diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index 06629c8..c4bfa85 100644
--- a/lib/Net/DBus/Binding/Iterator.pm
+++ b/lib/Net/DBus/Binding/Iterator.pm
@@ -398,14 +398,17 @@ sub append {
     my $value = shift;
     my $type = shift;
 
-    if (ref($value) eq "Net::DBus::Binding::Value") {
+    if (ref($value) eq "Net::DBus::Binding::Value" &&
+        ((! defined ref($type)) ||
+	 (ref($type) ne "ARRAY") ||
+	 $type->[0] != &Net::DBus::Binding::Message::TYPE_VARIANT)) {
 	$type = $value->type;
 	$value = $value->value;
     }
 
     if (!defined $type) {
 	$type = $self->guess_type($value);
-    }	
+    }
 
     if (ref($type) eq "ARRAY") {
 	my $maintype = $type->[0];
diff --git a/lib/Net/DBus/Test/MockIterator.pm b/lib/Net/DBus/Test/MockIterator.pm
index 1a4df79..c6b95c3 100644
--- a/lib/Net/DBus/Test/MockIterator.pm
+++ b/lib/Net/DBus/Test/MockIterator.pm
@@ -563,14 +563,17 @@ sub append {
     my $value = shift;
     my $type = shift;
 
-    if (ref($value) eq "Net::DBus::Binding::Value") {
+    if (ref($value) eq "Net::DBus::Binding::Value" &&
+        ((! defined ref($type)) ||
+	 (ref($type) ne "ARRAY") ||
+	 $type->[0] != &Net::DBus::Binding::Message::TYPE_VARIANT)) {
 	$type = $value->type;
 	$value = $value->value;
     }
 
     if (!defined $type) {
 	$type = $self->guess_type($value);
-    }	
+    }
 
     if (ref($type) eq "ARRAY") {
 	my $maintype = $type->[0];
diff --git a/t/60-object-props.t b/t/60-object-props.t
index 99d5a48..5ef080b 100644
--- a/t/60-object-props.t
+++ b/t/60-object-props.t
@@ -1,5 +1,5 @@
 # -*- perl -*-
-use Test::More tests => 13;
+use Test::More tests => 16;
 
 use strict;
 use warnings;
@@ -42,13 +42,21 @@ sub parents {
     return $self->{parents};
 }
 
+sub height {
+    my $self = shift;
+    $self->{height} = shift if @_;
+    return $self->{height};
+}
+
 dbus_property("name", "string");
 dbus_property("email", "string", "read");
 dbus_property("age", "int32" ,"write");
 dbus_property("parents", ["array", "string"]);
+dbus_property("height", "double", "write");
 
 package main;
 
+use Net::DBus qw(:typing);
 my $bus = Net::DBus->test;
 my $service = $bus->export_service("org.cpan.Net.Bus.test");
 my $object = MyObject->new($service, "/org/example/MyObject");
@@ -64,6 +72,7 @@ my $xml_expect = <<EOF;
   <interface name="org.example.MyObject">
     <property name="age" type="i" access="write"/>
     <property name="email" type="s" access="read"/>
+    <property name="height" type="d" access="write"/>
     <property name="name" type="s" access="readwrite"/>
     <property name="parents" type="as" access="readwrite"/>
   </interface>
@@ -244,3 +253,20 @@ GET_EMAIL: {
 }
 
 
+SET_HEIGHT: {
+    my $msg = $bus->get_connection()->make_method_call_message("org.example.MyService",
+							       "/org/example/MyObject",
+							       "org.freedesktop.DBus.Properties",
+							       "Set");
+
+    $introspector->encode($msg, "methods", "Set", "params", "org.example.MyObject", "height", dbus_double(1.414));
+
+    is($msg->get_signature, "ssv", "signature is ssvd");
+
+    my $reply = $bus->get_connection->send_with_reply_and_block($msg);
+
+    is($reply->get_type, &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN);
+
+    ok($object->height > 1.410 &&
+       $object->height < 1.420, "height is 1.414");
+}

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git