Test attempt for passing objects around via O::R
Jess Robinson [Sat, 13 Oct 2012 18:32:16 +0000 (19:32 +0100)]
t/lib/ORTestObjects.pm [new file with mode: 0644]
t/objects.t [new file with mode: 0644]

diff --git a/t/lib/ORTestObjects.pm b/t/lib/ORTestObjects.pm
new file mode 100644 (file)
index 0000000..0e2195c
--- /dev/null
@@ -0,0 +1,30 @@
+package ORTestObjects;
+
+use Moo;
+
+has name => (is => 'rwp', default => sub { 'Fred' });
+
+sub same_name {
+    my ($self, $other) =  @_;
+
+    return $self->name eq $other->name;
+}
+
+sub give_back {
+    my ($self) = @_;
+
+    return $self;
+}
+
+sub takes_object {
+    my ($self, $object) = @_;
+
+    print STDERR ref($object);
+    if($object->isa('ORTestObjects')) {
+        return 1;
+    }
+
+    return 0;
+}
+
+1;
diff --git a/t/objects.t b/t/objects.t
new file mode 100644 (file)
index 0000000..dcd79a1
--- /dev/null
@@ -0,0 +1,24 @@
+use strictures 1;
+use Test::More;
+use Sys::Hostname qw(hostname);
+use overload ();
+
+use Object::Remote;
+
+$ENV{PERL5LIB} = join(
+  ':', ($ENV{PERL5LIB} ? $ENV{PERL5LIB} : ()), qw(lib t/lib)
+);
+
+my $connection = Object::Remote->connect('-');
+
+my $ortestobj_j = ORTestObjects->new::on($connection, { name => 'John' });
+my $ortestobj_k = ORTestObjects->new::on($connection, { name => 'Ken' });
+
+is($ortestobj_k->takes_object($ortestobj_j), 1, 'Passed correct object back over the wire');
+
+my $george = ORTestObjects->new::on($connection, { name => 'George'});
+my $george_again = $george->give_back;
+is($george->{remote}, $george_again->{remote}, 'objects appear to be the same');
+is($george->name, $george_again->name, 'objects have the same name');
+
+done_testing;