[libnet-dbus-perl] 245/335: Improve tests for magic values

[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 1cffd6984c998b96e16c9c3b634dbff3911c3d8d
Author: Daniel P. Berrange <berrange at redhat.com>
Date:   Thu Jul 12 10:41:20 2007 -0400

    Improve tests for magic values
---
 t/65-object-magic.t | 106 +++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 88 insertions(+), 18 deletions(-)

diff --git a/t/65-object-magic.t b/t/65-object-magic.t
index 9b6b69d..f3b9028 100644
--- a/t/65-object-magic.t
+++ b/t/65-object-magic.t
@@ -1,10 +1,10 @@
 # -*- perl -*-
-use Test::More tests => 7;
+use Test::More tests => 13;
 
 use strict;
 use warnings;
 
-BEGIN { 
+BEGIN {
     use_ok('Net::DBus::Binding::Introspector');
     use_ok('Net::DBus::Object');
 };
@@ -15,26 +15,38 @@ use base qw(Net::DBus::Object);
 use Net::DBus::Exporter qw(org.example.MyObject);
 
 dbus_method("test_set_serial", ["serial"]);
-dbus_method("test_set_caller", ["caller"]);
-
 sub test_set_serial {
     my $self = shift;
-    $self->{serial} = shift;
+    my @args = @_;
+    $self->{lastargs} = \@args;
 }
 
-sub test_get_serial {
+dbus_method("test_set_caller", ["caller"]);
+sub test_set_caller {
     my $self = shift;
-    return $self->{serial};
+    my @args = @_;
+    $self->{lastargs} = \@args;
 }
 
-sub test_set_caller {
+dbus_method("test_set_multi_args1", ["string", "caller"]);
+sub test_set_multi_args1 {
+    my $self = shift;
+    my @args = @_;
+    $self->{lastargs} = \@args;
+}
+
+dbus_method("test_set_multi_args2", ["caller", "string"]);
+sub test_set_multi_args2 {
     my $self = shift;
-    $self->{caller} = shift;
+    my @args = @_;
+    $self->{lastargs} = \@args;
 }
 
-sub test_get_caller {
+dbus_method("test_set_multi_args3", ["string", "caller", "string"]);
+sub test_set_multi_args3 {
     my $self = shift;
-    return $self->{caller};
+    my @args = @_;
+    $self->{lastargs} = \@args;
 }
 
 package main;
@@ -46,7 +58,7 @@ my $object = MyObject->new($service, "/org/example/MyObject");
 my $introspector = $object->_introspector;
 
 my $xml_got = $introspector->format();
-    
+
 my $xml_expect = <<EOF;
 <!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"
 "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">
@@ -54,6 +66,16 @@ my $xml_expect = <<EOF;
   <interface name="org.example.MyObject">
     <method name="test_set_caller">
     </method>
+    <method name="test_set_multi_args1">
+      <arg type="s" direction="in"/>
+    </method>
+    <method name="test_set_multi_args2">
+      <arg type="s" direction="in"/>
+    </method>
+    <method name="test_set_multi_args3">
+      <arg type="s" direction="in"/>
+      <arg type="s" direction="in"/>
+    </method>
     <method name="test_set_serial">
     </method>
   </interface>
@@ -81,28 +103,76 @@ is($xml_got, $xml_expect, "xml data matches");
 
 CALLER: {
     my $msg = Net::DBus::Binding::Message::MethodCall->new(service_name => "org.example.MyService",
-							   object_path => "/org/example/MyObject",      
+							   object_path => "/org/example/MyObject",
 							   interface => "org.example.MyObject",
 							   method_name => "test_set_caller");
     $msg->set_sender(":1.1");
 
     my $reply = $bus->get_connection->send_with_reply_and_block($msg);
     is($reply->get_type, &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN);
-    
-    is($object->test_get_caller, ":1.1", "caller is :1.1");
+
+    is_deeply($object->{lastargs}, [":1.1"], "caller is :1.1");
 }
 
 
 SERIAL: {
     my $msg = Net::DBus::Binding::Message::MethodCall->new(service_name => "org.example.MyService",
-							   object_path => "/org/example/MyObject",      
+							   object_path => "/org/example/MyObject",
 							   interface => "org.example.MyObject",
 							   method_name => "test_set_serial");
 
     my $reply = $bus->get_connection->send_with_reply_and_block($msg);
 
     is($reply->get_type, &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN);
-    
-    is($object->test_get_serial, $msg->get_serial, "serial matches");
+
+    is_deeply($object->{lastargs}, [$msg->get_serial], "serial matches");
 }
 
+MULTI_ARGS1: {
+    my $msg = Net::DBus::Binding::Message::MethodCall->new(service_name => "org.example.MyService",
+							   object_path => "/org/example/MyObject",
+							   interface => "org.example.MyObject",
+							   method_name => "test_set_multi_args1");
+    $msg->set_sender(":1.1");
+    my $iter = $msg->iterator(1);
+    $iter->append_string("one");
+
+    my $reply = $bus->get_connection->send_with_reply_and_block($msg);
+
+    is($reply->get_type, &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN);
+
+    is_deeply($object->{lastargs}, ["one",":1.1"], "caller matches");
+}
+
+MULTI_ARGS2: {
+    my $msg = Net::DBus::Binding::Message::MethodCall->new(service_name => "org.example.MyService",
+							   object_path => "/org/example/MyObject",
+							   interface => "org.example.MyObject",
+							   method_name => "test_set_multi_args2");
+    $msg->set_sender(":1.1");
+    my $iter = $msg->iterator(1);
+    $iter->append_string("one");
+
+    my $reply = $bus->get_connection->send_with_reply_and_block($msg);
+
+    is($reply->get_type, &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN);
+
+    is_deeply($object->{lastargs}, [":1.1", "one"], "caller matches");
+}
+
+MULTI_ARGS3: {
+    my $msg = Net::DBus::Binding::Message::MethodCall->new(service_name => "org.example.MyService",
+							   object_path => "/org/example/MyObject",
+							   interface => "org.example.MyObject",
+							   method_name => "test_set_multi_args3");
+    $msg->set_sender(":1.1");
+    my $iter = $msg->iterator(1);
+    $iter->append_string("one");
+    $iter->append_string("two");
+
+    my $reply = $bus->get_connection->send_with_reply_and_block($msg);
+
+    is($reply->get_type, &Net::DBus::Binding::Message::MESSAGE_TYPE_METHOD_RETURN);
+
+    is_deeply($object->{lastargs}, ["one",":1.1", "two"], "caller matches");
+}

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