Permalink
Browse files

Filter::Reference test and ascilliary files

  • Loading branch information...
1 parent 2f3c667 commit a23337a11c69d3df21462a91cf68158c2f6fd1b7 @rcaputo committed Jun 21, 2000
Showing with 181 additions and 2 deletions.
  1. +2 −0 MANIFEST
  2. +0 −1 lib/POE/Filter/Reference.pm
  3. +39 −0 mylib/MyOtherFreezer.pm
  4. +9 −1 mylib/TestSetup.pm
  5. +6 −0 mylib/coverage.perl
  6. +125 −0 tests/17_filter_ref.t
View
@@ -29,6 +29,7 @@ POE/Wheel/ListenAccept.pm
POE/Wheel/ReadWrite.pm
POE/Wheel/SocketFactory.pm
README
+lib/MyOtherFreezer.pm
lib/TestSetup.pm
samples/create.perl
samples/fakelogin.perl
@@ -75,3 +76,4 @@ t/13_wheels_udp.t
t/14_wheels_ft.t
t/15_filter_block.t
t/16_filter_stream.t
+t/17_filter_ref.t
@@ -76,7 +76,6 @@ sub new {
$tf=sub {$freeze->($freezer, @_)};
$tt=sub {$thaw->($freezer, @_)};
}
-
# Compression
$compression ||= 0;
if ($compression) {
View
@@ -0,0 +1,39 @@
+# $Id$
+# A sample external freezer for POE::Filter::Reference testing.
+
+package MyOtherFreezer;
+
+sub new {
+ my $type = shift;
+ return bless [ ], $type;
+}
+
+sub freeze {
+ my $thing = shift;
+ $thing = shift if ref($thing) eq 'MyOtherFreezer';
+
+ if (ref($thing) eq 'SCALAR') {
+ return reverse(join "\0", ref($thing), $$thing);
+ }
+ elsif (ref($thing) eq 'Package') {
+ return reverse(join "\0", ref($thing), @$thing);
+ }
+ die;
+}
+
+sub thaw {
+ my $thing = shift;
+ $thing = shift if ref($thing) eq 'MyOtherFreezer';
+
+ my ($type, @stuff) = split /\0/, reverse($thing);
+ if ($type eq 'SCALAR') {
+ my $scalar = $stuff[0];
+ return \$scalar;
+ }
+ elsif ($type eq 'Package') {
+ return bless \@stuff, $type;
+ }
+ die;
+}
+
+1;
View
@@ -9,7 +9,7 @@ use Exporter;
@TestSetup::ISA = qw(Exporter);
@TestSetup::EXPORT = qw( &test_setup
&stderr_pause &stderr_resume
- &ok &not_ok &ok_if &ok_unless &results
+ &ok &not_ok &ok_if &ok_unless &results &many_not_ok
);
my $test_count;
@@ -91,6 +91,14 @@ sub not_ok {
}
}
+sub many_not_ok {
+ my ($start_number, $end_number, $reason) = @_;
+
+ for (my $test = $start_number; $test <= $end_number; $test++) {
+ &not_ok($test, $reason);
+ }
+}
+
sub ok_if {
my ($test_number, $value, $reason) = @_;
View
@@ -44,6 +44,12 @@
unlink "$test_file.coverage";
+ $test_file =~ /\/(\d+)_/;
+ my $test_number = $1 + 0;
+ if (@ARGV) {
+ next unless grep /^0*$test_number$/, @ARGV;
+ }
+
print "*** Testing $test_file ...\n";
# System returns 0 on success.
View
@@ -0,0 +1,125 @@
+#!/usr/bin/perl -w
+# $Id$
+
+# Exercises Filter::Reference without the rest of POE.
+
+use strict;
+use lib qw(./lib ../lib);
+use POE::Filter::Reference;
+
+use TestSetup;
+
+# Determine whether we can run these tests.
+{ local $SIG{__WARN__} = sub { };
+ my $reference = eval { POE::Filter::Reference->new(); };
+ if (length $@) {
+ $@ =~ s/\n.*$//;
+ &test_setup(0, $@);
+ exit;
+ }
+}
+
+# A trivial, special-case serializer and reconstitutor.
+
+sub MyFreezer::freeze {
+ my $thing = shift;
+ if (ref($thing) eq 'SCALAR') {
+ return reverse(join "\0", ref($thing), $$thing);
+ }
+ elsif (ref($thing) eq 'Package') {
+ return reverse(join "\0", ref($thing), @$thing);
+ }
+ die;
+}
+
+sub MyFreezer::thaw {
+ my $thing = reverse(shift);
+ my ($type, @stuff) = split /\0/, $thing;
+ if ($type eq 'SCALAR') {
+ my $scalar = $stuff[0];
+ return \$scalar;
+ }
+ elsif ($type eq 'Package') {
+ return bless \@stuff, $type;
+ }
+ die;
+}
+
+# Start our engines.
+&test_setup(80);
+
+# Run some tests under a certain set of conditions.
+sub test_freeze_and_thaw {
+ my ($test_number, $freezer, $compression) = @_;
+
+ my $scalar = 'this is a test';
+ my $scalar_ref = \$scalar;
+ my $object_ref = bless [ 1, 1, 2, 3, 5 ], 'Package';
+
+ my $filter;
+ eval {
+ # Hide warnings.
+ local $SIG{__WARN__} = sub { };
+ $filter = POE::Filter::Reference->new( $freezer, $compression );
+ };
+
+ if (length $@) {
+ $@ =~ s/[^\n]\n.*$//;
+ &many_not_ok($test_number, $test_number + 9, $@);
+ return;
+ }
+
+ my $put = $filter->put( [ $scalar_ref, $object_ref ] );
+ my $got = $filter->get( $put );
+
+ if (@$got == 2) {
+ &ok($test_number);
+
+ if (ref($got->[0]) eq 'SCALAR') {
+ &ok($test_number + 1);
+ &ok_if($test_number + 2, ${$got->[0]} eq $scalar);
+ }
+ else {
+ &many_not_ok($test_number + 1, $test_number + 2);
+ }
+
+ if (ref($got->[1]) eq 'Package') {
+ &ok($test_number + 3);
+
+ if (@{$got->[1]} == 5) {
+ &ok($test_number + 4);
+ &ok_if($test_number + 5, $got->[1]->[0] == 1);
+ &ok_if($test_number + 6, $got->[1]->[1] == 1);
+ &ok_if($test_number + 7, $got->[1]->[2] == 2);
+ &ok_if($test_number + 8, $got->[1]->[3] == 3);
+ &ok_if($test_number + 9, $got->[1]->[4] == 5);
+ }
+ else {
+ &many_not_ok( $test_number + 4, $test_number + 9);
+ }
+ }
+ else {
+ &many_not_ok($test_number + 3, $test_number + 9);
+ }
+ }
+ else {
+ &many_not_ok($test_number, $test_number + 9);
+ }
+}
+
+# Test each combination of things.
+&test_freeze_and_thaw( 1, undef, undef );
+&test_freeze_and_thaw( 11, undef, 9 );
+&test_freeze_and_thaw( 21, 'MyFreezer', undef );
+&test_freeze_and_thaw( 31, 'MyFreezer', 9 );
+&test_freeze_and_thaw( 41, 'MyOtherFreezer', undef );
+&test_freeze_and_thaw( 51, 'MyOtherFreezer', 9 );
+
+my $freezer = MyOtherFreezer->new();
+
+&test_freeze_and_thaw( 61, $freezer, undef );
+&test_freeze_and_thaw( 71, $freezer, 9 );
+
+&results();
+
+exit;

0 comments on commit a23337a

Please sign in to comment.