QPID-4505: Provide Perl unit tests.

These tests ensure that the Perl language bindings are working as
expected, and that changes to either the underlying C++ implementation
or the Perl bindings themselves don't break those expectations.

git-svn-id: https://svn.apache.org/repos/asf/qpid/trunk/qpid@1423688 13f79535-47bb-0310-9956-ffa450edef68

6 files changed, 534 insertions, 59 deletions

diff --git a/cpp/bindings/qpid/perl/ChangeLog b/cpp/bindings/qpid/perl/ChangeLog
index b937ff3343..4de5631217 100644
--- a/cpp/bindings/qpid/perl/ChangeLog
+++ b/cpp/bindings/qpid/perl/ChangeLog
@@ -1,3 +1,5 @@
 Version 0.22 (TBA):
 	* QPID-4466: qpid::messaging::Duration now supports multiplication
 	* QPID-4416: Messages with embedded nulls won't break on getContentPtr
+	* QPID-4505: Provides unit tests for Address, Duration and Message
+
diff --git a/cpp/bindings/qpid/perl/t/Address.t b/cpp/bindings/qpid/perl/t/Address.t
new file mode 100644
index 0000000000..4e74f8cad2
--- /dev/null
+++ b/cpp/bindings/qpid/perl/t/Address.t
@@ -0,0 +1,102 @@
+#!/usr/bin/env perl -w
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied.  See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Test::More qw(no_plan);
+use Test::Exception;
+
+require 'utils.pm';
+
+# verify that qpid is available
+BEGIN { use_ok( 'qpid' ); }
+require_ok ('qpid' );
+
+# construction
+# address cannot be null
+dies_ok (sub {new qpid::messaging::Address(undef);},
+         "Address cannot be null");
+
+# can use an address
+my $address = new qpid::messaging::Address("0.0.0.0");
+ok ($address, "Can be created with an arbitrary address");
+
+# name
+# name cannot be null
+dies_ok (sub {$address->set_name(undef);},
+         "Name cannot be null");
+
+# name can be an empty string
+$address->set_name("");
+ok ($address->get_name() eq "",
+    "Name can be empty");
+
+# name can be an arbitrary string
+my $name = random_string(25);
+$address->set_name($name);
+ok ($address->get_name() eq $name,
+    "Name can be an arbitrary string");
+
+# subject
+# cannot be null
+dies_ok (sub {$address->set_subject(undef);},
+         "Subject cannot be null");
+
+# can be an empty string
+$address->set_subject("");
+ok ($address->get_subject() eq "",
+    "Subject can be empty");
+
+# can be an arbitrary string
+my $subject = random_string(64);
+$address->set_subject($subject);
+ok ($address->get_subject() eq $subject,
+    "Subject can be an arbitrary string");
+
+# options
+# options cannot be null
+dies_ok (sub {$address->set_options(undef);},
+         "Options cannot be null");
+
+# options can be an empty hash
+$address->set_options({});
+ok (eq_hash($address->get_options(), {}),
+    "Options can be an empty hash");
+
+# options cannot be arbitrary values
+my %options = ("create", "always", "delete", "always");
+$address->set_options(\%options);
+ok (eq_hash($address->get_options(), \%options),
+    "Options can be arbitrary keys");
+
+# type
+# cannot be null
+dies_ok (sub {$address->set_type(undef);},
+         "Type cannot be null");
+
+# can be an empty string
+$address->set_type("");
+ok ($address->get_type() eq "",
+    "Type can be an empty string");
+
+# can be an arbitrary string
+my $type = random_string(16);
+$address->set_type($type);
+ok ($address->get_type() eq $type,
+    "Type can be an arbitrary type");
+
diff --git a/cpp/bindings/qpid/perl/t/Duration.t b/cpp/bindings/qpid/perl/t/Duration.t
new file mode 100644
index 0000000000..6975e8006f
--- /dev/null
+++ b/cpp/bindings/qpid/perl/t/Duration.t
@@ -0,0 +1,124 @@
+#!/usr/bin/env perl -w
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied.  See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Test::More qw(no_plan);
+use Test::Exception;
+
+require 'utils.pm';
+
+# verify that qpid is available
+BEGIN { use_ok( 'qpid' ); }
+require_ok ('qpid' );
+
+# milliseconds
+# duration cannot be null
+{
+    dies_ok (sub {new qpid::messaging::Duration(undef);},
+             "Durations cannot have null time periods");
+}
+
+# duration cannot be negative
+{
+    my $period = 0 - (int(rand(65535)) + 1);
+    dies_ok(sub {new qpid::messaging::Duration($period);},
+            "Duration times cannot be negative");
+}
+
+# duration can be an arbitrary value
+{
+    my $period = int(rand(65535));
+    my $duration = new qpid::messaging::Duration($period);
+    ok ($duration->get_milliseconds() == $period,
+        "Milliseconds are properly stored and fetched");
+}
+
+# multiplier
+# cannot multiply by null
+dies_ok(sub {qpid::messaging::Duration::FOREVER * undef;},
+        "Cannot multiply a duration times a null");
+
+# cannot multiply by a negative
+dies_ok (sub {qpid::messaging::Duration::MINUTE * -2;},
+         "Duration cannot be multiplied by a negative");
+
+# multiply by zero returns a zero time period
+{
+    my $result = qpid::messaging::Duration::MINUTE * 0;
+
+    ok ($result->get_milliseconds() == 0,
+        "Multiplying duration by 0 returns a 0 duration");
+}
+
+# multiply by arbitrary values works
+{
+    my $factor = int(1 + rand(100));
+    my $result = qpid::messaging::Duration::MINUTE * $factor;
+    ok ($result->get_milliseconds() == 60000 * $factor,
+        "Multiplying by a factor returns a new Duration with that period");
+}
+
+# equality
+# always fails with null
+ok (!(qpid::messaging::Duration::MINUTE == undef),
+    "Duration is never equal to null");
+
+# never equal to a non-duration class
+ok (!(qpid::messaging::Duration::MINUTE == random_string(12)),
+    "Duration is never equal to a non-Duration");
+
+# works with self
+ok (qpid::messaging::Duration::MINUTE == qpid::messaging::Duration::MINUTE,
+    "Duration is always equal to itself");
+
+# fails with non-equal instance
+ok (!(qpid::messaging::Duration::MINUTE == qpid::messaging::Duration::SECOND),
+    "Duration non-equality works");
+
+# works with equal instance
+{
+    my $result = qpid::messaging::Duration::MINUTE * 0;
+    ok ($result == qpid::messaging::Duration::IMMEDIATE,
+        "Equality comparison works correctly");
+}
+
+# non-equality
+# always not equal to null
+ok (qpid::messaging::Duration::MINUTE != undef,
+    "Always unequal to null");
+
+# always not equal to a non-duration class
+ok (qpid::messaging::Duration::MINUTE != random_string(64),
+    "Always unequal to a non-duration class");
+
+# not unequal to itself
+ok (!(qpid::messaging::Duration::MINUTE != qpid::messaging::Duration::MINUTE),
+    "Never unequal to itself");
+
+# not unequal to an equal instance
+{
+    my $duration = qpid::messaging::Duration::MINUTE * 1;
+    ok (!(qpid::messaging::Duration::MINUTE != $duration),
+        "Never unequal to an equal instance");
+}
+
+# works with unequal instances
+ok (qpid::messaging::Duration::MINUTE != qpid::messaging::Duration::FOREVER,
+    "Always unequal to a non-equal instance");
+
diff --git a/cpp/bindings/qpid/perl/t/Message.t b/cpp/bindings/qpid/perl/t/Message.t
new file mode 100644
index 0000000000..142e1719b3
--- /dev/null
+++ b/cpp/bindings/qpid/perl/t/Message.t
@@ -0,0 +1,268 @@
+#!/usr/bin/env perl -w
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied.  See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Test::More qw(no_plan);
+use Test::Exception;
+
+require 'utils.pm';
+
+# verify that qpid is available
+BEGIN { use_ok( 'qpid' ); }
+require_ok ('qpid' );
+
+# Create a new message
+my $message = new qpid::messaging::Message();
+isa_ok($message, 'qpid::messaging::Message');
+
+# reply to
+# rejects an null address
+dies_ok (sub {$message->set_reply_to(undef);},
+         "Reply to cannot be null.");
+
+# can handle a string address
+$message->set_reply_to("test");
+ok ($message->get_reply_to()->str() eq "test",
+    "Reply to can be set");
+
+# subject
+# cannot have an null subject
+dies_ok (sub {$message->set_subject(undef);},
+         "Subject cannot be null");
+
+# can have an empty subject
+$message->set_subject("");
+ok ($message->get_subject() eq "",
+    "Subject can be empty");
+
+# can have a subject
+my $subject = random_string(16);
+$message->set_subject($subject);
+ok ($message->get_subject() eq $subject,
+    "Subject can be set.");
+
+# content type
+# cannot have an null content type
+dies_ok (sub {$message->set_content_type(undef);},
+         "Content type must be defined.");
+
+# can an empty content type
+$message->set_content_type("");
+ok ($message->get_content_type() eq "",
+    "Content type can be empty");
+
+# can have an arbitrary content type
+my $content_type = random_string(10);
+$message->set_content_type($content_type);
+ok ($message->get_content_type() eq $content_type,
+    "Content type can be arbitrary");
+
+# can be for a map
+$content_type = "amqp/map";
+$message->set_content_type($content_type);
+ok ($message->get_content_type() eq $content_type,
+    "Content type can be for a map");
+
+# message id
+# cannot be null
+dies_ok (sub {$message->set_message_id(undef);},
+         "Message id cannot be null");
+
+# can be an empty string
+$message->set_message_id("");
+ok ($message->get_message_id() eq "",
+    "Message id can be empty");
+
+# can be an arbitrary string
+my $id = random_string(32);
+$message->set_message_id($id);
+ok ($message->get_message_id() eq $id,
+    "Message id can be an arbitrary string");
+
+# can be a UUID
+$id = generate_uuid();
+$message->set_message_id($id);
+ok ($message->get_message_id() eq $id,
+    "Message id can be a valid UUID");
+
+# user id
+# cannot be null
+dies_ok (sub {$message->set_user_id(undef);},
+         "User id cannot be null");
+
+# can be an empty string
+my $user_id = "";
+$message->set_user_id($user_id);
+ok ($message->get_user_id() eq $user_id,
+    "User id can be empty");
+
+# can be an arbitrary string
+$id = random_string(65);
+$message->set_user_id($user_id);
+ok ($message->get_user_id() eq $user_id,
+    "User id can be an arbitrary string");
+
+# correlation id
+# cannot be null
+dies_ok (sub {$message->set_correlation_id(undef);},
+         "Correlation id cannot be null");
+
+# can be empty
+my $correlation_id = "";
+$message->set_correlation_id($correlation_id);
+ok ($message->get_correlation_id() eq $correlation_id,
+    "Correlation id can be an empty string");
+
+# can be an arbitrary string
+$correlation_id = random_string(32);
+$message->set_correlation_id($correlation_id);
+ok ($message->get_correlation_id() eq $correlation_id,
+    "Correlation id can be an arbitrary string");
+
+# priority
+# cannot be nul
+dies_ok (sub {$message->set_priority(undef);},
+         "Priority cannot be null");
+
+# cannot be negative
+my $priority = 0 - (rand(2**8) + 1);
+dies_ok (sub {$message->set_priority($priority);},
+         "Priority cannot be negative");
+
+# can be 0
+$message->set_priority(0);
+ok ($message->get_priority() == 0,
+    "Priority can be zero");
+
+# can be an arbitrary value
+$priority = int(rand(2**8) + 1);
+$message->set_priority($priority);
+ok ($message->get_priority() == $priority,
+    "Priority can be any positive value");
+
+# ttl
+# cannot be null
+dies_ok (sub {$message->set_ttl(undef);},
+         "TTL cannot be null");
+
+# can be a duration
+$message->set_ttl(qpid::messaging::Duration::FOREVER);
+ok ($message->get_ttl()->get_milliseconds() == qpid::messaging::Duration::FOREVER->get_milliseconds(),
+    "TTL can be a Duration");
+
+# if numeric, is converted to a duration
+my $duration = rand(65535);
+$message->set_ttl($duration);
+ok ($message->get_ttl()->get_milliseconds() == int($duration),
+    "TTL can be any arbitrary duration");
+
+# if 0 it's converted to IMMEDIATE
+$message->set_ttl(0);
+ok ($message->get_ttl()->get_milliseconds() == qpid::messaging::Duration::IMMEDIATE->get_milliseconds(),
+    "TTL of 0 is converted to IMMEDIATE");
+
+# if negative it's converted to FOREVER
+$message->set_ttl(0 - (rand(65535) + 1));
+ok ($message->get_ttl()->get_milliseconds() == qpid::messaging::Duration::FOREVER->get_milliseconds(),
+    "TTL of <0 is converted to FOREVER");
+
+# durable
+# cannot be null
+dies_ok (sub {$message->set_durable(undef);},
+         "Durable cannot be null");
+
+# can be set to true
+$message->set_durable(1);
+ok ($message->get_durable(),
+    "Durable can be true");
+
+# can be set to false
+$message->set_durable(0);
+ok (!$message->get_durable(),
+    "Durable can be false");
+
+# redelivered
+# redelivered cannot be null
+dies_ok (sub {$message->set_redelivered(undef);},
+         "Redelivered cannot be null");
+
+# can be set to true
+$message->set_redelivered(1);
+ok ($message->get_redelivered(),
+    "Redelivered can be true");
+
+# can be set to false
+$message->set_redelivered(0);
+ok (!$message->get_redelivered(),
+    "Redelivered can be false");
+
+# properties
+# can retrieve all properties
+my $properties = $message->get_properties();
+ok (UNIVERSAL::isa($properties, 'HASH'),
+    "Returns the properties as a hash map");
+
+# property
+# setting a property using a null key fails
+dies_ok (sub {$message->set_property(undef, "bar");},
+         "Property cannot have a null key");
+
+# setting a property with a null value succeeds
+my $key = random_string(16);
+$message->set_property($key, undef);
+ok (!$message->get_properties()->{$key},
+    "Properties can have null values");
+
+# setting a property succeeds
+my $value = random_string(255);
+$message->set_property($key, $value);
+ok ($message->get_properties()->{$key} eq $value,
+    "Messages can have arbitrary property values");
+
+# content
+# cannot be null
+dies_ok (sub {$message->set_content(undef);},
+         "Content cannot be null");
+
+# can be an empty string
+$message->set_content("");
+ok ($message->get_content() eq "",
+    "Content can be an empty string");
+
+# can be an arbitrary string
+my $content = random_string(255);
+$message->set_content($content);
+ok ($message->get_content() eq $content,
+    "Content can be an arbitrary string");
+
+# Embedded nulls should be handled properly
+$content = { id => 1234, name => "With\x00null" };
+qpid::messaging::encode($content, $message);
+my $map = qpid::messaging::decode_map($message);
+
+ok ($map->{name} eq "With\x00null",
+    "Nulls embedded in map values work.");
+
+# content size
+# content size is correct
+my $content_size = int(rand(256));
+$content = random_string($content_size);
+$message->set_content($content);
+ok ($message->get_content_size() == $content_size,
+    "Content size is correct");
diff --git a/cpp/bindings/qpid/perl/t/utils.pm b/cpp/bindings/qpid/perl/t/utils.pm
new file mode 100644
index 0000000000..db8093d324
--- /dev/null
+++ b/cpp/bindings/qpid/perl/t/utils.pm
@@ -0,0 +1,38 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied.  See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Digest::MD5;
+
+sub random_string
+{
+    my $len=$_[0];
+    my @chars=('a'..'z','A'..'Z','0'..'9','_');
+    my $result;
+
+    foreach (1..$len) {
+        $result .= $chars[rand @chars];
+    }
+    return $result;
+}
+
+sub generate_uuid
+{
+    return Digest::MD5::md5_base64( rand );
+}
+
+1;
diff --git a/cpp/bindings/qpid/perl/test/test-null-inside-map.pl b/cpp/bindings/qpid/perl/test/test-null-inside-map.pl
deleted file mode 100644
index 2c1e698abb..0000000000
--- a/cpp/bindings/qpid/perl/test/test-null-inside-map.pl
+++ /dev/null
@@ -1,59 +0,0 @@
-#!/usr/bin/perl
-#
-# Licensed to the Apache Software Foundation (ASF) under one
-# or more contributor license agreements.  See the NOTICE file
-# distributed with this work for additional information
-# regarding copyright ownership.  The ASF licenses this file
-# to you under the Apache License, Version 2.0 (the
-# "License"); you may not use this file except in compliance
-# with the License.  You may obtain a copy of the License at
-#
-#   http://www.apache.org/licenses/LICENSE-2.0
-#
-# Unless required by applicable law or agreed to in writing,
-# software distributed under the License is distributed on an
-# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
-# KIND, either express or implied.  See the License for the
-# specific language governing permissions and limitations
-# under the License.
-#
-use strict;
-use warnings;
-use Data::Dumper;
-
-use cqpid_perl;
-
-my $broker            = ( @ARGV > 0 ) ? $ARGV[0] : "localhost:5672";
-my $address           = ( @ARGV > 1 ) ? $ARGV[0] : "amq.match";
-my $connectionOptions = ( @ARGV > 2 ) ? $ARGV[1] : "";
-
-my $in_address = "amq.match; {link:{x-bindings:[{exchange: 'amq.match', arguments:{'x-match': 'all', 'header2' : 'value2'}}]}}";
-
-my $connection = new cqpid_perl::Connection($broker, $connectionOptions);
-
-eval {
-    $connection->open();
-    my $session = $connection->createSession();
-
-    my $receiver = $session->createReceiver($in_address);
-    my $sender   = $session->createSender($address);
-
-    my $hash = { id => 1234, name => "Blah\x00Blah" };
-    my $outmsg = new cqpid_perl::Message("Hello\x00World");
-    cqpid_perl::encode($hash, $outmsg);
-    $outmsg->setProperty("header2", "value2"); 
-    $sender->send($outmsg);
-
-    my $message = $receiver->fetch($cqpid_perl::Duration::SECOND);
-
-    print Dumper($message->getProperties());
-
-    print $message->getContent() . "\n";
-    my $outmap = cqpid_perl::decodeMap($message);
-    print Dumper($outmap);
-    $session->acknowledge();
-
-    $connection->close();
-};
-
-die $@ if ($@);